Wednesday, August 27, 2025

VBA Word Resize all images of document proportionately

VBA Word code which resizes all images of the document proportionately so that they all fit inside the document. You can keep width of images 80% or some other percentage of width of the document width.
Sub ResizeAllImages()
    Dim shp As InlineShape
    Dim fshp As Shape
    Dim doc As Document
    Dim pageWidth As Single
    Dim marginWidth As Single
    Dim usableWidth As Single
    Dim targetWidth As Single
    
    Set doc = ActiveDocument
    
    ' Calculate usable width (page width minus left and right margins)
    pageWidth = doc.PageSetup.PageWidth
    marginWidth = doc.PageSetup.LeftMargin + doc.PageSetup.RightMargin
    usableWidth = pageWidth - marginWidth
    
    ' Set target width = 80% of usable width
    targetWidth = usableWidth * 0.8
    
    ' Loop through inline shapes (images inside text)
    For Each shp In doc.InlineShapes
        If shp.Type = wdInlineShapePicture Or shp.Type = wdInlineShapeLinkedPicture Or shp.Type = wdInlineShapeEmbeddedOLEObject Then
            ' Resize proportionally
            shp.LockAspectRatio = msoTrue
            If shp.Width > targetWidth Then
                shp.Width = targetWidth
            End If
        End If
    Next shp
    
    ' Loop through floating shapes (images not inline)
    For Each fshp In doc.Shapes
        If fshp.Type = msoPicture Or fshp.Type = msoLinkedPicture Then
            ' Resize proportionally
            fshp.LockAspectRatio = msoTrue
            If fshp.Width > targetWidth Then
                fshp.Width = targetWidth
            End If
        End If
    Next fshp
    
    MsgBox "All images resized to max width = 80% of document width.", vbInformation
End Sub

No comments:

Post a Comment

Hot Topics