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.

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:

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:

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:

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:

After:

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:

• Resize Pictures.docm

See also:

• Word VBA, Picture Format CropBottom, CropLeft, CropRight and CropTop
• Word VBA, Shape Index
• Word VBA, Loop Through Images

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