Skip to content

Resize all images in Ms Word to same size with few click

Let’s say you have multiple images in Ms Word and you need to resize all of them to same size uniformly. Imagine time and effort in resizing 20 (or more) image one by one. This blog shows you a trick to resize all image in Ms Word document to same size just few clicks.

We will be using a feature called Macro to resize all image to your required size. See Macro that we will be creating in action in following video.

Table of Contents

See feature in action with live demo

How to resize all images of Ms Word to same size in few clicks

The above video uses a Macro to resize images.

The steps to add above macro is as follows:

  1. Go to View > Macros > View Macros to open Macros Window
    Insert macro in Ms Word
  2. Type macro name “ResizeAllInagesWithAspectRatio” or any other name of your choice in Macro Name and click Create
    create macro
  3. Copy macro given below, paste it as shown and click save.
    Insert macro to resize all images in Ms Word
  4. Close visual basic.

How to use this macro to resize all images in any Ms Word document

  1. Open word document where you need to resize all images to your desired size.
  2. Go to View > Macros > View Macros to open Macros Window
  3. Select “ResizeAllInagesWithAspectRatio” and click Run
    Run macro to resize all images to same size
  4. Enter desired width and height (in centimeters) of image you need when prompted.
  5. Select “Yes” to maintain aspect ratio of image or “No” to Strech image to above size.
  6. All images in current document will be resized as per above options.

Macro to resize all images in few click

Sub ResizeAllImagesWithAspectRatio()
    Dim oShp As Shape
    Dim oILShp As InlineShape
    Dim targetWidth As Single
    Dim targetHeight As Single
    Dim maintainAspectRatio As Boolean

    ' Prompt the user for the desired image dimensions
    targetWidth = InputBox("Enter the desired width (in centimeters):")
    targetHeight = InputBox("Enter the desired height (in centimeters):")
    maintainAspectRatio = MsgBox("Maintain aspect ratio? Click Yes to maintain, No to stretch.", vbYesNo + vbQuestion) = vbYes

    ' Resize all images (both inline and floating)
    For Each oShp In ActiveDocument.Shapes
        With oShp
            If maintainAspectRatio Then
                .LockAspectRatio = msoTrue
                .Height = AspectHt(.Width, .Height, CentimetersToPoints(targetWidth))
            Else
                .LockAspectRatio = msoFalse
                .Height = CentimetersToPoints(targetHeight)
            End If
            .Width = CentimetersToPoints(targetWidth)
        End With
    Next

    For Each oILShp In ActiveDocument.InlineShapes
        With oILShp
            If maintainAspectRatio Then
                .LockAspectRatio = msoTrue
                .Height = AspectHt(.Width, .Height, CentimetersToPoints(targetHeight))
            Else
                .LockAspectRatio = msoFalse
                .Height = CentimetersToPoints(targetHeight)
            End If
            .Width = CentimetersToPoints(targetWidth)
        End With
    Next
End Sub

Function AspectHt(originalWidth As Single, originalHeight As Single, targetWidth As Single) As Single
    ' Calculate the proportional height based on the target width
    AspectHt = (originalHeight / originalWidth) * targetWidth
End Function

Related Posts

Leave a Reply

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