CODEWITHSUNDEEP
vbams-wordshapes
hans_h
hans_h

Reputation: 46

VBA - Rotate Word.Shapes In A Word-Document

Here's the question I'm having. I need to rotate Word.Shapes in a single Word-Document, but my script will only rotate the first one, and i can't figure out why.

Here's how the Word-Document comes to be (opens a PDF with one Shape per page):

Set wrdDoc = wrdAppMain.Documents.Open(FileName:=sToSaveAs, Visible:=False)

Here's how the loop is designed:

For Each wrdShape In wrdDoc.Shapes

    If CheckFormat(wrdShape) = False Then
        FitToPage = False
        GoTo ExitScript
    End If

Next wrdShape

And now the part that's acting up:

Private Function CheckFormat(oShapeToCheck As Word.Shape) As Boolean

    On Error GoTo Failed

    Dim siAspectRatio As Single
    Dim iRotation As Integer

     '---- Seitenverhältnis und Rotation berechnen ----
     If oShapeToCheck.Height > 0 And oShapeToCheck.Width > 0 Then
        siAspectRatio = oShapeToCheck.Height / oShapeToCheck.Width
        iRotation = oShapeToCheck.Rotation
     Else
        ErrorCode = " (PDF)"
        GoTo Failed
     End If

     '---- Kontrolle ob Bild im Querformat vorliegt ----
     If siAspectRatio < 1 Then

     '---- Kontrolle ob rotiert oder natives Querformat ----
     Select Case iRotation
         Case 0
             oShapeToCheck.IncrementRotation 90
         Case 180
             oShapeToCheck.IncrementRotation 270
         Case 90
             oShapeToCheck.IncrementRotation 0
         Case 270
             oShapeToCheck.IncrementRotation 180
     End Select

So and here's where the problem is. Although I the first Word.Shape meeting the criteria will be rotated, any others will not. Additionally if I set the visibility for the Word-Document to TRUE, debug through, and fullscreen the Word-Document before the script performs the rotation, it will rotate any Word.Shape every time.

I tried messing around with .Activate and the like but nothing seems to work. Hope you can help me there!

Thanks!

Markus

Upvotes: 1

Views: 2107

Answers (2)

James Martin
James Martin

Reputation: 1

Frustrating, that new code is repasted in broken sections - can't get to work.

Upvotes: 0

hans_h
hans_h

Reputation: 46

So I found a way to make this work. Instead of rotating every Word.Shape individually, I gather them all in a ShapeRange via their Indexes (or whatever the plural is on that one) and rotate them all at once.

Select Case iRotation
        Case 0
            If bIsDimensioned = False Then
                ReDim Preserve RotationArray(0 To 0) As Variant
                RotationArray(0) = iShapeIndex
                bIsDimensioned = True
            Else
                ReDim Preserve RotationArray(0 To UBound(RotationArray) + 1) As Variant
                RotationArray(UBound(RotationArray)) = iShapeIndex
            End If
End Select

And after the ShapeRange is fully populated:

If bIsDimensioned = True Then
    Set RotationShapeRange = wrdDoc.Shapes.Range(RotationArray)
    RotationShapeRange.IncrementRotation 90
    RotationShapeRange.WrapFormat.Type = wdWrapTight
    RotationShapeRange.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    RotationShapeRange.RelativeVerticalPosition = wdRelativeVerticalPositionPage
    RotationShapeRange.Left = wdShapeCenter
    RotationShapeRange.Top = wdShapeCenter
End If

That should be it!

Upvotes: 1

Related Questions