Word / VBScript

Resizing Images In A Word Macro

​​​Creating word documents from a content management system can introduce certain issues. One of which is that images output from the CMS may not be down-sized properly to fit within the bounds of a page or even within a table cell. To fix this I have tweaked the following vbscript macro for word.

Sub AutoResizeGraphics()
    Dim photo As InlineShape
    PArea = 15.24 ‘ Set something for default page width – margins
    ‘ All images in Document
    ‘   For Each shape In ActiveDocument.InlineShapes
    ‘ All images in Selection
    ‘   For Each shape In Selection.InlineShapes
    For Each photo In ActiveDocument.InlineShapes
        With photo
            OrigWidth = .Width
            OrigHeight = .Height
            photomaxwidth = OrigWidth
            tablewidthpercent = 0.95
            ‘ calculate new pagewidth based on the section the image is within
            With .Range.PageSetup
                RMargin = PointsToInches(.RightMargin)
                LMargin = PointsToInches(.LeftMargin)
                PArea = 2.54 * (PointsToInches(.PageWidth) – (LMargin + RMargin)) ‘ convert to cm
            End With
            pagewidthminusmargins = PArea ‘ in cm not points or in
            If PointsToCentimeters(OrigWidth) > pagewidthminusmargins Then
                photomaxwidth = CentimetersToPoints(pagewidthminusmargins)
            End If
            If photo.Range.Information(wdWithInTable) = True Then
                TablePhotoMaxWidth = .Range.Cells(1).Width * tablewidthpercent
                If (OrigWidth > TablePhotoMaxWidth) Then
                    photomaxwidth = TablePhotoMaxWidth
                End If
            End If
            If Not photomaxwidth = OrigWidth Then
                Ratio = OrigWidth / photomaxwidth
                .LockAspectRatio = msoFalse
                .Height = OrigHeight / Ratio
                .Width = photomaxwidth ‘OrigWidth / Ratio
                .LockAspectRatio = msoTrue
            End If
        End With
End Sub​