How to resize all images in Word document?

Here’s a simple VBA macro that will resize all images in a Word document to 16 cm width preserving the aspect ratio.

Code Snippet

1. Sub AllPictSize()
2.     Dim targetWidth As Integer
3.     Dim oShp As Shape
4.     Dim oILShp As InlineShape
5.  
6.     targetWidth = 16
7.  
8.     For Each oShp In ActiveDocument.Shapes
9.         With oShp
10.             .Height = AspectHt(.Width, .Height, _
11.             CentimetersToPoints(targetWidth))
12.             .Width = CentimetersToPoints(targetWidth)
13.         End With
14.     Next
15.  
16.     For Each oILShp In ActiveDocument.InlineShapes
17.         With oILShp
18.             .Height = AspectHt(.Width, .Height, CentimetersToPoints(targetWidth))
19.             .Width = CentimetersToPoints(targetWidth)
20.         End With
21.     Next
22. End Sub
23.  
24. Private Function AspectHt(ByVal origWd As Long, ByVal origHt As Long, ByVal newWd As Long) As Long
25.     If origWd <> 0 Then
26.         AspectHt = (CSng(origHt) / CSng(origWd)) * newWd
27.     Else
28.         AspectHt = 0
29.     End If
30. End Function