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.

If you insert the images into table cells of fixed width, the image will shrink to the width of the table cell without the need for a macro and the height of the cell will grow to accommodate the height of the picture.

OR

Add the Format Frame ... command to your QAT (Quick Access Toolbar) and insert a frame to hold the pictures. As with table cells, pictures will shrink to the width of the frame and the height will grow as required. Both can be inserted with or without borders.

If you are doing a lot of work with image captures investigate SnagIt which has lots of useful image editing tools and capture options.

You may also find http://www.gmayor.com/photo_gallery_template.html useful.

__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com

Cross-posted (and answered) at: http://www.vbaexpress.com/forum/show...esize-Pictures
For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184

__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]

Thanks for suggesting Snagit. It does exactly what I need, which is getting a screen capture at a constant size and aspect ratio. This alleviates the need adjust the size and aspect ratio after the fact. Thank you for your help. Much appreciated.

I've got a similar problem. But resolved if images are embedded in Outlook emails via customer mobiles, and not classed as attachments. If I forward the customer's email and copy the Forwarded Email Body and paste H in a docx, the images are wrapped/justified. Just trying to code this, I have one attempt from Page Not Found - Slipstick Systems which I have changed to docx with header and attachment list which my method doesn't do. Haven't managed to add to the code to resolve yet, looks like going to have to code my way and paste H and sort out a full header.

I'm testing this, so far ok. May need to exempt TIFF files that we occasionally get from customers as additional pages can be hidden.


Sub ResizePicturesWithinMarginIF()

Dim oDoc As Document, oShape As InlineShape
Set oDoc = Application.ActiveDocument

For Each oShape in oDoc.inlineShapes
If oShape.Width > 510 Then
oShape.LockAspectRatio = True
oShape.Width = 510
End If

If oShape.Height > 660 Then
oShape.LockAspectRatio = True
oShape.Height = 660

End If


Next

Set oDoc = Nothing

End Sub