在Word文档中旋转Word.Shapes

Question

这就是我的问题。我需要在一个Word文档中旋转Word.Shapes，但是我的脚本只旋转第一个文档，我不知道为什么。

下面是Word-Document是如何实现的(打开一个每页一个形状的PDF )：

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

下面是循环是如何设计的：

For Each wrdShape In wrdDoc.Shapes

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

Next wrdShape

现在出现问题的部分是：

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

所以这就是问题所在。尽管满足条件的第一个Word.Shape将被旋转，但其他任何一个都不会。此外，如果我将Word-Document的可见性设置为TRUE，在脚本执行旋转之前调试并全屏显示Word-Document，则每次都会旋转任何Word.Shape。

我试着摆弄.Activate之类的东西，但似乎什么都不起作用。希望你能在这方面给我帮助！

谢谢!

马库斯

Answer 1

所以我找到了一种方法来解决这个问题。我不是单独旋转每个Word.Shape，而是通过它们的索引(或该索引上的任何复数)将它们都收集到一个ShapeRange中，并一次性旋转它们。

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

在ShapeRange完全填充之后：

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

应该就是这样了！

Answer 2

令人沮丧的是，新代码被重新粘贴到不完整的部分中--无法正常工作。