Previously in the article Word VBA, Crop Images I’ve explained how you can use VBA for word to crop pictures in a word document. The method used in that article focused on resizing the pictures shape container and moving the shape inside its container. In this article I will explain how you can crop images using the built in functions below:

1. CropBottom
2. CropLeft
3. CropRight
4. CropTop

Before reading this article I would recommend readers to familiarize themselves with the difference between floating and inline pictures:

• Word VBA, Loop Through Images

I would also recommend readers familiarizing themselves with shape indexes:

• Word VBA, Shape Index

You might be wondering why I made the post Word VBA, Crop Images when there are built in functions for cropping images? Both methods for cropping images have there own complexities. I will leave to the readers to decide which method to use.

Assume we have  a picture with the following dimensions:

Note: the dimensions are in points.

The code below will crop 40 points from the bottom of the image:

InlineShapes.Item(1).PictureFormat.CropBottom = 40


Note: It is assumed the picture is an inline shape with the index 1.

Result:

As you can see 40 points were removed from the bottom of the picture.

So far everything seems straight forward with the CropBottom method. Problems occur when the picture has been scaled. Pictures are mainly scaled in 2 instances:

• Upon inserting the image
• Resizing done by user

The results obtained above will only occur when the image hasn’t been scaled. For example lets say the image is scaled by 0.5:

When using the CropBottom method, the program will compare the 40 points with the initial 100 points height of the picture:

60% = 40pt/100pt

40 points on the initial (unscaled) picture, is 60% of its height, therefore the image will be cropped by 60% of its height, which is 20 points:

20pt = 60%/100%*50pt

One method for overcoming this would be to use the code below:

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

'the points to crop
lngPoint2Crop = 80
'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
'apply crop
InlineShapes.Item(1).PictureFormat.CropBottom _
= lngPoint2Crop * lngOriginalHeight / lngScaledHeight
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 height it was:

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


The line below crops the image:

InlineShapes.Item(1).PictureFormat.CropBottom _
= lngPoint2Crop * lngOriginalHeight / lngScaledHeight


Note: This is not necessarily a good method. The reason is because the picture has to be resized to gets its  original size. This resizing may mess up your word document.

This can be overcome by using the code below. The code below automates a new word document, copies the picture to the new document, gets the scale ratio and crops the pictures:

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

'the points to crop
lngPoint2Crop = 80
'copy the picture
InlineShapes.Item(1).Select
Selection.Copy
'create new document and paste the picture
Set objDocument = Documents.Add
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 the new document
objDocument.Close (False)
ThisDocument.Activate
'apply crop
InlineShapes.Item(1).PictureFormat.CropBottom _
= lngPoint2Crop * lngOriginalHeight / lngScaledHeight
End Sub


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

Before:

After:

Note:

As you can see in the code above all the variables were declared as Long:

Dim lngPoint2Crop As Long
Dim lngOriginalHeight As Long
Dim lngScaledHeight As Long


Had we used integer values, an overflow error might have occured. For more information on this topic please see the link below:

• Word VBA OverFlow Error When Multiplying/Adding Integers

Crop Left, Right, Top:

Cropping the Left, Right and Top sides of the picture can all be done by replacing the last line of the codes above with the following codes:

InlineShapes.Item(1).PictureFormat.CropLeft


InlineShapes.Item(1).PictureFormat.CropRight


InlineShapes.Item(1).PictureFormat.CropTop


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

• Crop Image, Method 2.docm

See also:

• Word VBA, Crop Images
• Word VBA, Picture Dimensions
• Word VBA Resize Pictures

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