Word VBA, PictureFormat CropBottom, CropLeft, CropRight and CropTop

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:

I would also recommend readers familiarizing themselves with shape indexes:

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:

Picture, Initial 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:
Picture, Crop Bottom
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:

Scaled Picture
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:

Word VBA, Crop Before
After:
Word VBA Crop 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:


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:

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

Leave a Reply

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