MS Word VBA - Modify all Shapes (Pictures) in ActiveDocument

[kennyrogersjr]

Hey folks,

Been awhile since I've needed to consult my go-to forum for VBA questions. I found some hints stating that the code-junkies perusing Mr. E's interwebs like to go a few rounds with the other MS VBA dialects.

If someone can point out my flaw, I would appreciate it. I can't get past the "Invalid use of property" compile error on my first "si.ScaleHeight" line. See below:

Sub CenterPics()

Dim si As InlineShape
Dim s As Shape

Set docAD = ActiveDocument

    For Each si In docAD.Shapes
        Select Case si.Type
            Case msoEmbeddedOLEObject, msoLinkedOLEObject, msoOLEControlObject, msoLinkedPicture, msoPicture
                si.ScaleHeight 0.89, True
                si.ScaleWidth 0.89, True
                si.Left = wdShapeCenter
                si.Top = wdShapeCenter
                si.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
                si.RelativeVerticalPosition = wdRelativeVerticalPositionPage
            Case Else
                si.ScaleHeight 0.89, False
                si.ScaleWidth 0.89, False
                si.Left = wdShapeCenter
                si.Top = wdShapeCenter
                si.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
                si.RelativeVerticalPosition = wdRelativeVerticalPositionPage
        End Select
    Next

    For Each s In docAD.Shapes
        Select Case s.Type
            Case msoEmbeddedOLEObject, msoLinkedOLEObject, msoOLEControlObject, msoLinkedPicture, msoPicture
                s.ScaleHeight 0.89, True
                s.ScaleWidth 0.89, True
                s.Left = wdShapeCenter
                s.Top = wdShapeCenter
                s.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
                s.RelativeVerticalPosition = wdRelativeVerticalPositionPage
            Case Else
                s.ScaleHeight 0.89, False
                s.ScaleWidth 0.89, False
                s.Left = wdShapeCenter
                s.Top = wdShapeCenter
                s.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
                s.RelativeVerticalPosition = wdRelativeVerticalPositionPage
        End Select
    Next
End Sub

Been pouring over MSDN and various forums to find my error and I just can't see what I did wrong. A second pair of eyes reviewing my code would be helpful.

Ken

 

[kennyrogersjr]

Well, the InlineShape Object cannot support the ScaleHeight property... I ended up running with this simplified version and it worked for mostly all of my pictures. I had a few random ones that the original picture size was astronomical and the picture ended up around 400% larger than what it was scaled to, but the script handled the rest of the tedious work.

Sub CenterPics()

Dim si As InlineShape
Dim s As Shape

Set docAD = ActiveDocument

    For Each s In docAD.Shapes
                s.ScaleHeight 0.89, True 'Sets scale to 89% of original picture/shape size
                s.ScaleWidth 0.89, True 'Sets scale to 89% of original picture/shape size
                s.Left = wdShapeCenter 'Centers Horizontally
                s.Top = wdShapeCenter 'Centers Vertically
                s.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage 'Does it again
                s.RelativeVerticalPosition = wdRelativeVerticalPositionPage 'Does it again
    Next
End Sub

If anyone has any improvements or features to add, post away. I don't mind.