MS Word VBA: Resize Pictures & Graphics based on threshold and fix left margin alignment

 

ALT+F11 access VBA window, create new module, paste this code, adjust threshold & target  parameters follow your requirements.

Sub ResizeAllLargeGraphics()

    Dim ishp As InlineShape

    Dim shp As Shape

    Dim threshold As Single: threshold = InchesToPoints(8)

    Dim target As Single: target = InchesToPoints(8)

    'means resize all pictures and graphics with width >8 to 8

    

'resize and reallocate picture

    For Each ishp In ActiveDocument.InlineShapes

        If ishp.Width >= threshold Then

            With ishp

                .LockAspectRatio = msoTrue

                .Width = target

                .Range.ParagraphFormat.Alignment = wdAlignParagraphLeft

                .Range.ParagraphFormat.FirstLineIndent = 0

            End With

        End If

    Next ishp

    

    'resize and reallocate graphic

    For Each shp In ActiveDocument.Shapes

        If shp.Width >= threshold Then

            With shp

                .LockAspectRatio = msoTrue

                .Width = target

                .RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin

                .Left = 0

            End With

        End If

    Next shp

    

    MsgBox "done!", vbInformation

End Sub