VBA

Question

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

Word 文档是这样形成的（打开每页有一个形状的 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 文档的可见性设置为 TRUE，在脚本执行旋转之前调试并全屏显示 Word 文档，它每次都会旋转任何 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

令人沮丧的是，新代码被重新粘贴在损坏的部分中 - 无法开始工作。

VBA - 在 Word 文档中旋转 Word.Shapes

VBA - Rotate Word.Shapes In A Word-Document

ms-word

shapes