Word VBA Macro Needed to Crop & Resize Pictures

[Alex Cheng]

Hi Everyone, first post here so please bear with me if I'm not posting in the right place.

I'm a real estate appraiser and I often need to insert various digital photos of property within my reports that are written in MS Word. I'm currently using a macro to shrink down the images I've inserted into my Word documents so that they fit into the width of the document. The macro I've been using looks like this:

Public Sub ResizePictures()
Dim oDoc As Document, oShape As InlineShape
Set oDoc = Application.ActiveDocument

For Each oShape In oDoc.InlineShapes
  oShape.Width = 216
Next oShape

Set oDoc = Nothing
End Sub

This macro works great when the orginal images are of the same size and aspect ratio, as they would be coming from a digital camera, however, I now need to screen grab images (using the built in windows Snipping Tool) from online sources like Google Maps and because these screen grab images now have variable sizes and aspect ratios, this macro cannot reduce the photos in a consistent manner, and as a result, the shrunken images end up being different sizes in the Word document. I think this has to do with the locking aspect ratio of the images.

I am hoping that someone could help me modify this macro to account for variable image sizes and aspect ratios. I'm thinking the easiest method might be to crop the screen grab images so that they are in a standard aspect ratio (something like 3:2), and then shrinking the images down as I have been. Naturally the cropping must be minimal so that the image doesn't lose its integrity, but still get to a constant aspect ratio before they are shrunk down. Perhaps there is a better way to do this, but not knowing much about editing images, I'm certainly open to any suggestions that may produce the desired results.

I hope I've provided enough information to at least get the ball rolling, but please let me know if there are any details missing. I thank you all in advance for your help.