Consulting

Results 1 to 3 of 3

Thread: Formatting Pictures (InlineShapes) with Aspect Ratio

Hybrid View

Previous Post Previous Post   Next Post Next Post
  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;

    [vba]
    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
    [/vba]
    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
    4,435
    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
    Last edited by macropod; 08-19-2008 at 03:58 AM.
    Cheers
    Paul Edstein
    [Fmr 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:

    [vba]
    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
    [/vba]
    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:

    [vba]
    Const maxW As Double = CentimetersToPoints(27.7)
    Const maxH As Double = CentimetersToPoints(15)
    [/vba]
    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
  •