Word VBA Resize Pictures

In this article I will explain how you can use VBA for word to resize pictures in word. In order to resize a picture you would need determine 2 things:

  1. Whether the picture is an inline or floating shape
  2. The shape index associated with the picture

Note: Throughout this article it is assumed that the picture is inline and the shape index is 1. The concepts in this article could also be applied to floating pictures by using the Shapes collection.


Contents

Basics:

pictures are resized using the .ScaleHeight and .ScaleWidth property of their associated shape container. This property determines the size in percent relative to the original picture size to scale the image.

Example:

The following code resizes the picture height to 90% of the original picture height:

InlineShapes.Item(1).ScaleHeight = 90

Example:

The following code resizes the picture width to 40% of the original picture width:

Shapes.Item(1).ScaleWidth = 40

The problem with the code above is that the picture is scaled relative to its original size. Note that if not resized by the user, larger picture are resized by default upon being inserted in the word document.

For example take a look at the figure below:

Word VBA Picture

Upon running the code below we would expect the height of the image to be reduced by 30 percent,  but instead the image becomes longer in height:

InlineShapes.Item(1).ScaleHeight = 70

Result:

Word VBA resize Picture Result
The reason for this is because the original picture size is almost twice the size of the current picture. The picture was rescaled upon inserting into the document. In the figure below you can see the image in its full scale:

Word VBA Original Image Size


Method 1:

One method for overcomming this would be to follow the algorithm below:

  1. Scale the image back to its original size
  2. Get the image height
  3. Scale the image back to its initial size
  4. Scale the image with a ratio

The code below does this:

Sub Example1()
Dim lngPercent2Scale As Long
Dim lngOriginalHeight As Long
Dim lngScaledHeight As Long

'percent to resize
lngPercent2Scale = 70
'the height of the scaled image
lngScaledHeight = InlineShapes.Item(1).Height
'rescale to original size
InlineShapes.Item(1).ScaleHeight = 100
'the size of the original image
lngOriginalHeight = InlineShapes.Item(1).Height
'rescale image
InlineShapes.Item(1).ScaleHeight = _
lngScaledHeight / lngOriginalHeight * 100
'resize
InlineShapes.Item(1).ScaleHeight _
= lngPercent2Scale * lngScaledHeight / lngOriginalHeight
End Sub

The line below gets the picture height:

lngScaledHeight = InlineShapes.Item(1).Height

The code below resizes the picture to its original size and gets the height of the original picture:

InlineShapes.Item(1).ScaleHeight = 100
'the size of the original image
lngOriginalHeight = InlineShapes.Item(1).Height

The line below resizes the image back to the initial height:

InlineShapes.Item(1).ScaleHeight = _
lngScaledHeight / lngOriginalHeight * 100

The line resizes the image

InlineShapes.Item(1).ScaleHeight _
= lngPercent2Scale * lngScaledHeight / lngOriginalHeight

Note: There is one problem with this method. It is the fact that the image is actually resized to its original size to gets its original height . This resizing might mess up your word document. A better method would be to copy the picture to a new document and rescale it there. This is explained in the next section.


Method 2:

In this method the following algorithm is used:

  1. Automate a new word document
  2. Copy the picture to the new document
  3. Scale the image back to its original size
  4. Get the image height
  5. Close the extra word document
  6. Scale the image with a ratio

The code below does this:

Sub Example2()
Dim objDocument As Document
Dim lngPercent2Scale As Long
Dim lngOriginalHeight As Long
Dim lngScaledHeight As Long

'percent to resize
lngPercent2Scale = 70
Set objDocument = Documents.Add
InlineShapes.Item(1).Select
Selection.Copy
objDocument.Activate
Selection.Paste
'the height of the scaled image
lngScaledHeight = _
ActiveDocument.InlineShapes.Item(1).Height
'rescale to original size
ActiveDocument.InlineShapes.Item(1).ScaleHeight = _
100
'the size of the original image
lngOriginalHeight = _
ActiveDocument.InlineShapes.Item(1).Height
'close document
objDocument.Close (False)
ThisDocument.Activate
'resize
InlineShapes.Item(1).ScaleHeight _
= lngPercent2Scale * lngScaledHeight / lngOriginalHeight
End Sub

The code below automates a new word document, copies the image and pastes it in the new document:

Set objDocument = Documents.Add
InlineShapes.Item(1).Select
Selection.Copy
objDocument.Activate
Selection.Paste

The rest of the code is similar to the previous section.

Before:

Word Resize Before Picture
After:

Word VBA After Resize Picture


LockAspectRatio:

By default pictures have their LockAspectRatio set to True. This will result in the width resizing when you scale the height and vice versa. This can be changed by using the code below:

InlineShapes.Item(1).LockAspectRatio = msoFalse


Resize Picture Width:

This can be done using the code below:

Sub Example3()
Dim objDocument As Document
Dim lngPercent2Scale As Long
Dim lngOriginalWidth As Long
Dim lngScaledWidth As Long

InlineShapes.Item(1).LockAspectRatio = msoFalse
'percent to resize
lngPercent2Scale = 70
Set objDocument = Documents.Add
InlineShapes.Item(1).Select
Selection.Copy
objDocument.Activate
Selection.Paste
'the height of the scaled image
lngScaledWidth = _
ActiveDocument.InlineShapes.Item(1).Width
'rescale to original size
ActiveDocument.InlineShapes.Item(1).ScaleWidth = _
100
'the size of the original image
lngOriginalWidth = _
ActiveDocument.InlineShapes.Item(1).Width
'close document
objDocument.Close (False)
ThisDocument.Activate
'resize
InlineShapes.Item(1).ScaleWidth _
= lngPercent2Scale * lngScaledWidth / lngOriginalWidth
End Sub

The highlighted text sets the LockAspectRatio to false. This will prevent the picture height from resizing when the width is resized. The rest of the code is pretty much the same as the previous section.

You can download the file and code related to this article from the link below:

See also:

 

If you need assistance with your code, or you are looking for a VBA programmer to hire feel free to contact me. Also please visit my website  www.software-solutions-online.com

 

3 thoughts on “Word VBA Resize Pictures”

Leave a Reply

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