Consulting

Results 1 to 3 of 3

Thread: Formatting Pictures (InlineShapes) with Aspect Ratio

  1. #1
    VBAX Regular sbrbot's Avatar
    Joined
    Aug 2008
    Location
    Zagreb, Croatia
    Posts
    13
    Location

    Lightbulb Formatting Pictures (InlineShapes) with Aspect Ratio

    I have inline pictures (InlineShapes) in my Word document. The document is an export from third party application (Casewise business process documentation) and it should be formatted and refurbished before final corporation publishing. I'd like to pass through all my pictures (process diagrams) and to resize vector pictures to fit into landscape page.

    The issue here is that when I set LockAspectRatio attribute on of InlineShape and change the width of picture, it's height is not changed accordingly. Seems that keeping aspect ratio does not work. Does it mean that I have to recalculate height myself?

    Another question regarding pictures (InlineShapes) is, where is stored original picture size (what attributes)?

    So my code looks like this;

    Sub FormatPictures() 
        Dim š As InlineShape 
        Dim h As Long 
        For Each š In ActiveDocument.InlineShapes 
            š.LockAspectRatio = msoTrue 
            If (š.Width > CentimetersToPoints(27.7)) Then š.Width = CentimetersToPoints(27.7) 
            If (š.Height > CentimetersToPoints(15)) Then š.Height = CentimetersToPoints(15) 
        Next š 
    End Sub 
    
    
    Formatting tags added by mark007
    I expect that this code should shrink horizontaly my picture to 27.7 cm if the picture is wider than that and to shrink it verticaly to 15 cm if the picture is higher than that (just to fit it into my available page space). Of course, I expect that in both cases picture should be resized with aspect ratio kept. But...

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,185
    Location
    Hi sbrbot,

    It's quite reasonable to expect that setting the aspect ratio would result in the horizontal & vertical sizes adjusting proportionately. Unfortunately, that's not how it works in practice. Here's a workaround:
    Sub FormatPictures() 
        Dim š As InlineShape 
        Dim Aspect As Double 
        For Each š In ActiveDocument.InlineShapes 
            Aspect = š.Width / š.Height 
            If (š.Width > CentimetersToPoints(27.7)) Then 
                š.Width = CentimetersToPoints(27.7) 
                š.Height = š.Width / Aspect 
            ElseIf (š.Height > CentimetersToPoints(15)) Then 
                š.Height = CentimetersToPoints(15) 
                š.Width = š.Height * Aspect 
            End If 
        Next š 
    End Sub 
    
    
    Formatting tags added by mark007
    Last edited by macropod; 08-19-2008 at 03:58 AM.
    Cheers
    Paul Edstein
    [MS MVP - Word]

  3. #3
    VBAX Regular sbrbot's Avatar
    Joined
    Aug 2008
    Location
    Zagreb, Croatia
    Posts
    13
    Location
    Thanks macropod,

    of course I know how to mathematically preserve my aspect ratio but it was surprising for me that built in functionality does not work. I was researching about this LockAspectRation on Internet and found out that it seems that this feature really does not work in VBA. Bad luck. However, here is my code:

    Sub FormatPictures() 
         
        Dim maxW As Double: maxW = CentimetersToPoints(27.7) 
        Dim maxH As Double: maxH = CentimetersToPoints(15) 
         
        Dim š As InlineShape 
        Dim r As Double ' Width/Height ratio
         
        For Each š In ActiveDocument.InlineShapes 
            r = š.Width / š.Height 'aspect ratio AR
            If (š.Width > maxW) Then 
                š.Width = maxW 'resize horizontally
                š.Height = š.Width / r 'keep AR
            End If 
            If (š.Height > maxH) Then 
                š.Height = maxH 'resize vertically
                š.Width = š.Height * r 'keep AR
            End If 
        Next š 
         
    End Sub 
    
    
    Formatting tags added by mark007
    BTW, in your code you have one logical mistake, you cannot use ElseIf but separate If .. EndIf for each shrinking, you think why.

    P.S. Why I cannot declare this:

    Const maxW As Double = CentimetersToPoints(27.7) 
    Const maxH As Double = CentimetersToPoints(15) 
    
    
    Formatting tags added by mark007
    Last edited by sbrbot; 08-19-2008 at 04:30 AM.

Posting Permissions

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