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.
See feature in action with live demo
The above video uses a Macro to resize images.
The steps to add above macro is as follows:
- Go to View > Macros > View Macros to open Macros Window
- Type macro name “ResizeAllInagesWithAspectRatio” or any other name of your choice in Macro Name and click Create
- Copy macro given below, paste it as shown and click save.
- Close visual basic.
How to use this macro to resize all images in any Ms Word document
- Open word document where you need to resize all images to your desired size.
- Go to View > Macros > View Macros to open Macros Window
- Select “ResizeAllInagesWithAspectRatio” and click Run
- Enter desired width and height (in centimeters) of image you need when prompted.
- Select “Yes” to maintain aspect ratio of image or “No” to Strech image to above size.
- 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