Monday, 20 March 2017

SetAllImages In Word doc to one size

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: