Formatting Pictures (InlineShapes) with Aspect Ratio

[sbrbot]

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

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...

[macropod]

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

[sbrbot]

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

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)