Sub aSetAllPicturesSize()
Dim i As Long
Dim strNewWidth As String
strNewWidth = InputBox("Enter a width for all images: (eg 450)", "Image Size")
Dim intNewWidth As Integer
intNewWidth = CInt(strNewWidth)
Dim intNewHeight As Integer
intNewHeight = CInt(intNewWidth * 0.8)
Dim dblPercentChange As Double
With ActiveDocument
For i = 1 To .InlineShapes.Count
With .InlineShapes(i)
If .Height > .Width Then
' if we are not the height we we want, resize by percent
If .Height <> intNewHeight Then
dblPercentChange = CDbl(intNewHeight / .Height)
.Width = .Width * dblPercentChange
.Height = .Height * dblPercentChange
End If
Else
' this is for square or landscape images
If .Width <> intNewWidth Then
dblPercentChange = CDbl(intNewWidth / .Width)
.Width = .Width * dblPercentChange
.Height = .Height * dblPercentChange
End If
End If ' Portrait or Landscape
End With
Next i
End With
End Sub
No comments:
Post a Comment