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
- Sub AllPictSize()
- Dim targetWidth As Integer
- Dim oShp As Shape
- Dim oILShp As InlineShape
- targetWidth = 16
- For Each oShp In ActiveDocument.Shapes
- With oShp
- .Height = AspectHt(.Width, .Height, _
- CentimetersToPoints(targetWidth))
- .Width = CentimetersToPoints(targetWidth)
- End With
- Next
- For Each oILShp In ActiveDocument.InlineShapes
- With oILShp
- .Height = AspectHt(.Width, .Height, CentimetersToPoints(targetWidth))
- .Width = CentimetersToPoints(targetWidth)
- End With
- Next
- End Sub
- Private Function AspectHt(ByVal origWd As Long, ByVal origHt As Long, ByVal newWd As Long) As Long
- If origWd <> 0 Then
- AspectHt = (CSng(origHt) / CSng(origWd)) * newWd
- Else
- AspectHt = 0
- End If
- End Function
Hi
ReplyDeletehow do I change this macro to (selected images) only, not all images within the doc.
Quite useful! Thankyou.
ReplyDelete