VBA Resize all pictures in document

Many thanks for the below code from

http://www.vbaexpress.com/forum/showthread.php?21618-Formatting-Pictures-(InlineShapes)-with-Aspect-Ratio

 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub FormatPictures()
     
    Dim maxW As Double: maxW = CentimetersToPoints(14)
    Dim maxH As Double: maxH = CentimetersToPoints(11)
     
    Dim š As InlineShape
    Dim r As Double ' Width/Height ratio
     
    For Each š In ActiveDocument.InlineShapes
        r = š.Width / š.Height 'aspect ratio AR
        If (š.Width > maxW) Then
            š.Width = maxW 'resize horizontally
            š.Height = š.Width / r 'keep AR
        End If
        If (š.Height > maxH) Then
            š.Height = maxH 'resize vertically
            š.Width = š.Height * r 'keep AR
        End If
    Next š
     
End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *