为什么将VBA添加的水印放在Word文档中某些页面的不同位置？

Question

我已通过VBA代码在文档的所有页面中添加了水印。该代码在简单情况下可以正常工作，但是如果跨页的表很长，则无法很好地工作。 我已经在word2010和office365中进行了测试，结果略有不同，但都不理想

word2010结果

出现单词o365：

这是我的代码：

Sub Macro1()

 Call WaterMark_All("Remove")
 Selection.GoTo wdGoToPage, wdGoToAbsolute, 1
 Call WaterMark_All("Insert")

End Sub



Sub WaterMark_All(ByVal actiontype As String)
    Dim a, i
    a = ActiveDocument.BuiltInDocumentProperties("Number of Pages")

    For i = 1 To a
        If actiontype = "Insert" Then
            Call InsertWaterMark(i)
        Else
            Call RemoveWaterMark(i)
        End If

    Next

    Exit Sub

ErrHandler:
    MsgBox "An error occured trying to insert the watermark." & Chr(13) & _
    "Error Number: " & Err.Number & Chr(13) & _
    "Decription: " & Err.Description, vbOKOnly + vbCritical, "Error"

End Sub

Sub InsertWaterMark(ByVal page_num As Integer)

    If page_num = Selection.Information(wdActiveEndPageNumber) Then

        ActiveDocument.Shapes.AddTextEffect(msoTextEffect1, _
        "DRAFT", "Arial", 1, False, False, 0, 0).Select
        With Selection.ShapeRange

            .Name = "Watermark_Page_" & page_num
            .TextEffect.NormalizedHeight = False
            .Line.Visible = False

            With .Fill

                .Visible = True
                .Solid
                .ForeColor.RGB = Gray
                .Transparency = 0.5
            End With

            .LockAspectRatio = True
            .Height = InchesToPoints(2.42)
            .Width = InchesToPoints(6.04)

            With .WrapFormat
                .AllowOverlap = True
                .Side = wdWrapNone
                .Type = 3

            End With
            .RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
            .Left = InchesToPoints(0)
            .RelativeVerticalPosition = wdRelativeVerticalPositionMargin
            .Top = InchesToPoints(0)

        End With
        Selection.GoToNext What:=wdGoToPage
    End If
    Exit Sub

ErrHandler:
    'MsgBox "Error in Insert Water Mark [Page" & page_num & "]"
End Sub



Sub RemoveWaterMark(ByVal page_num As Integer)
    Dim strWMName As String
    On Error GoTo ErrHandler
    strWMName = "Watermark_Page_" & page_num
    ActiveDocument.Shapes(strWMName).Select
    Selection.Delete
    Exit Sub

ErrHandler:
    'MsgBox "Error in Remove Water Mark [Page" & page_num & "]"
End Sub

希望有人可以帮助我解决定位问题