Macro to resize Image(s)

Question

Macro to resize Image(s)

Anonymous

I have the Home and Student 2016 version, running under Windows 10.

Please help me create a macro that will resize a selected image to a given width, say 3 inches (the height should automatically change to keep the same ratio).

I need to be able to edit the macro to change 3 inches to a different measurement, but that should be easy enough to see how to edit the macro once I have the basic code to perform the resizing.

Additional question - is this possible?: A macro that can resize multiple images. Since I can't figure out a way to select multiple images when they are interspersed with text, I'm guessing this might not be possible.

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments

2 answers

Answer 1

To resize one picture:

Sub ResizePic()
    Select Case Selection.Type
      Case wdSelectionShape
        With Selection.ShapeRange
          Select Case .Type
            Case msoPicture, msoLinkedPicture
              .LockAspectRatio = msoTrue
              .Width = Application.InchesToPoints(3)
          End Select
        End With
      Case wdSelectionInlineShape
        With Selection.ShapeRange
          Select Case .Type
            Case wdInlineShapeLinkedPicture, wdInlineShapePicture
              .LockAspectRatio = msoTrue
              .Width = Application.InchesToPoints(3)
          End Select
        End With
    End Select
End Sub

To resize all pictures in the document:

Sub ResizePics()
    Dim shp As Shape
    Dim ish As InlineShape
    For Each shp In ActiveDocument.Shapes
        Select Case shp.Type
          Case msoPicture, msoLinkedPicture
            shp.LockAspectRatio = msoTrue
            shp.Width = Application.InchesToPoints(3)
        End Select
    Next shp
    For Each ish In ActiveDocument.InlineShapes
        Select Case ish.Type
          Case wdInlineShapeLinkedPicture, wdInlineShapePicture
            ish.LockAspectRatio = msoTrue
            ish.Width = Application.InchesToPoints(3)
        End Select
    Next ish
End Sub

Answer 2

Paul Edstein 82,861 Volunteer Moderator

You may also be interested in: Automate the Insertion of Multiple Images into a Document (msofficeforums.com)

0 comments

Share via

Macro to resize Image(s)

2 answers