Sunday, July 17, 2011

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

2 comments :

  1. Hi
    how do I change this macro to (selected images) only, not all images within the doc.

    ReplyDelete