vba - 文本框旋转问题

Question

我正在尝试编写一个宏来在我的 Word 文档中插入自定义水印。

该代码适用于文档的前两页，但此后文本框不会旋转到 -45，如代码中所述

我究竟做错了什么？

Sub CustomWatermark()

    Dim activeDoc As Document
    Dim rngDoc As Range
    Dim shpTextBox As Shape
    Dim lngPages As Long
    Dim i As Long
    Dim strWatermark As String
    
    
    Set activeDoc = ActiveDocument
    
    lngPages = activeDoc.Range.Information(wdNumberOfPagesInDocument)
    
    strWatermark = InputBox("Enter Watermark")
    
    With activeDoc
    
        For i = 1 To lngPages

            Set rngDoc = .GoTo(What:=wdGoToPage, Name:=i)
            rngDoc.Collapse wdCollapseStart
        
            Set shpTextBox = .Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
                                            Left:=InchesToPoints(1), _
                                            Top:=InchesToPoints(4), _
                                            Width:=InchesToPoints(6), _
                                            Height:=InchesToPoints(2), _
                                            Anchor:=rngDoc)
            With shpTextBox
                .Line.Visible = msoFalse
                .Rotation = -45
                .WrapFormat.Type = wdWrapBehind
                .TextFrame.HorizontalAnchor = msoAnchorCenter
                .TextFrame.VerticalAnchor = msoAnchorMiddle
                                                
                With .TextFrame.TextRange
                    .Font.AllCaps = True
                    .Font.Size = "60"
                    .Font.ColorIndex = wdGray25
                    .ParagraphFormat.Alignment = wdAlignParagraphCenter
                    .Text = strWatermark
                    
                End With
            End With
        Next
    End With
    

End Sub

标签： vbams-word

Answer 1

看起来，选择所有范围并立即进行旋转，可以...

Sub CustomWatermarkBis()
    Dim activeDoc As Document, rngDoc As Range, shpTextBox As Shape
    Dim lngPages As Long, i As Long, strWatermark As String, shR As ShapeRange
    Dim arrRot As Variant, k As Long
    
    Set activeDoc = ActiveDocument
    lngPages = activeDoc.Range.Information(wdNumberOfPagesInDocument)
    ReDim arrRot(0 To lngPages - 1)
    
    strWatermark = InputBox("Enter Watermark Text")
    With activeDoc
        For i = 1 To lngPages
            Set rngDoc = .GoTo(What:=wdGoToPage, Name:=i)
            rngDoc.Collapse wdCollapseStart
        
            Set shpTextBox = .Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
                                            Left:=InchesToPoints(1), _
                                            Top:=InchesToPoints(4), _
                                            Width:=InchesToPoints(6), _
                                            Height:=InchesToPoints(2), _
                                            Anchor:=rngDoc)
            With shpTextBox.TextFrame.TextRange
                .Font.AllCaps = True
                .Font.Size = "60"
                .Font.ColorIndex = wdGray25
                .ParagraphFormat.Alignment = wdAlignParagraphCenter
                .Text = strWatermark
            End With
            shpTextBox.Name = "T" & i
            arrRot(k) = shpTextBox.Name: k = k + 1
        Next
        Set shR = .Shapes.Range(arrRot)
    End With
    
    With shR
        .Select
        .Line.Visible = msoFalse
        .Rotation = -45
        .WrapFormat.Type = wdWrapBehind
        .TextFrame.HorizontalAnchor = msoAnchorCenter
        .TextFrame.VerticalAnchor = msoAnchorMiddle
    End With
    Selection.Collapse
End Sub