Consulting

Results 1 to 7 of 7

Thread: Word VBA Macro Needed to Crop & Resize Pictures

  1. #1
    VBAX Regular
    Joined
    Nov 2018
    Location
    Denver
    Posts
    9
    Location

    Word VBA Macro Needed to Crop & Resize Pictures

    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.
    Last edited by macropod; 11-29-2018 at 08:26 PM. Reason: Added code tags & formatting

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Before:
    oShape.Width = 216
    insert:
    oShape.LockAspectRatio = True

    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  3. #3
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Cross-posted at: http://www.msofficeforums.com/word-v...-pictures.html
    Please read VBA Express' policy on Cross-Posting in item 3 of the rules: http://www.vbaexpress.com/forum/faq...._new_faq_item3
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  4. #4
    VBAX Regular
    Joined
    Nov 2018
    Location
    Denver
    Posts
    9
    Location
    My apologies. I didn't know that cross-posting was prohibited.

  5. #5
    VBAX Regular
    Joined
    Nov 2018
    Location
    Denver
    Posts
    9
    Location
    Quote Originally Posted by macropod View Post
    Before:
    oShape.Width = 216
    insert:
    oShape.LockAspectRatio = True
    I tried your suggestion and it didn't make a difference in the results. I also tried setting LockAspectRatio = False and that made the results worse. I wonder if the LockAspectRatio parameter is true by default.

    Nevertheless, I think the issue is that since I'm doing a drag & drop screen grab, the size and aspect ratio of each image will be a little different. It doesn't appear that a difference in size makes that big of a difference in the result, but a difference in aspect ratio does.

  6. #6
    VBAX Regular
    Joined
    Nov 2018
    Location
    Denver
    Posts
    9
    Location
    Update: Someone on another forum suggested that I try Snagit, and it does exactly what I need, which is to capture the image in a fixed size and aspect ratio.

  7. #7
    I had to do this, as embedded images from customer mobiles
    are often embedded and larger than A4 when imported to docx
    via a https://www.slipstick.com/developer/...ook-email-pdf/ macro.

    It forces every embedded image within the A4 margins.


    Sub ResizePicturesIF()
    'Macro S
    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
    Last edited by Aussiebear; 10-29-2021 at 01:47 PM. Reason: Added code tags to supplied code

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •