Microsoft Office Forums - View Single Post - Watermark on every page of document which has different first/odd/even page headers

shanlau · 12-10-2018, 06:15 PM

It is a follow up question of my previous post in
https://www.msofficeforums.com/word-...ions-some.html

I want to add watermark by vba in every page of my document. The document has multiple sections with different first/odd/even page headers.

After running my code, some watermarks have been overlapped onto other pages and lead to a strange result.

Code:

Sub Macro1()
 
 Call RemoveWaterMark_All
 Call InsertWaterMark_All


End Sub




Sub InsertWaterMark_All()
    Dim strWMName As String
    Dim i, j As Integer
    On Error GoTo ErrHandler

    For i = 1 To ActiveDocument.Sections.Count
       ActiveDocument.Sections(i).Range.Select
       For j = 1 To 3
           Call InsertWaterMark(i, j)
       Next
    Next

     
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
     
    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 section_index As Integer, ByVal sv As Integer)
    Dim strWMName As String
    On Error GoTo ErrHandler
    If (sv = 1) Then
        strWMName = "Section" & i & "_FirstPage_Index" & ActiveDocument.Sections(section_index).Index
        ActiveWindow.ActivePane.View.SeekView = wdHeaderFooterFirstPage
    ElseIf (sv = 2) Then
        strWMName = "Section" & i & "_OddPage_Index" & ActiveDocument.Sections(section_index).Index
        ActiveWindow.ActivePane.View.SeekView = wdHeaderFooterPrimary
    ElseIf (sv = 3) Then
        strWMName = "Section" & i & "_EvenPage_Index" & ActiveDocument.Sections(section_index).Index
        ActiveWindow.ActivePane.View.SeekView = wdHeaderFooterEvenPages
    End If
    
    Selection.HeaderFooter.Shapes.AddTextEffect(msoTextEffect1, _
    "DRAFT", "Arial", 1, False, False, 0, 0).Select
    With Selection.ShapeRange
             
        .Name = strWMName
        .TextEffect.NormalizedHeight = False
        .Line.Visible = False
             
        With .Fill
                 
            .Visible = True
            .Solid
            .ForeColor.RGB = Gray
            .Transparency = 0.5
        End With
             
        '.Rotation = 315
        .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
    
    Exit Sub
    
ErrHandler:
    'MsgBox "Error in Insert Water Mark [" & section_index & "," & sv & "]"
End Sub

Sub RemoveWaterMark_All()
    Dim strWMName As String
    Dim i, j As Integer
    On Error GoTo ErrHandler
    
    
 For i = 1 To ActiveDocument.Sections.Count
     ActiveDocument.Sections(i).Range.Select
     For j = 1 To 3
        Call RemoveWaterMark(i, j)
    Next
 Next
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
     
    Exit Sub
     
     
ErrHandler:
    'MsgBox "An error occured trying to remove the watermark." & Chr(13) & _
    "Error Number: " & Err.Number & Chr(13) & _
    "Decription: " & Err.Description, vbOKOnly + vbCritical, "Error"
     
End Sub

Sub RemoveWaterMark(ByVal section_index As Integer, ByVal sv As Integer)
    Dim strWMName As String
    On Error GoTo ErrHandler
    If (sv = 1) Then
        strWMName = "Section" & i & "_FirstPage_Index" & ActiveDocument.Sections(section_index).Index
        ActiveWindow.ActivePane.View.SeekView = wdHeaderFooterFirstPage
    ElseIf (sv = 2) Then
        strWMName = "Section" & i & "_OddPage_Index" & ActiveDocument.Sections(section_index).Index
        ActiveWindow.ActivePane.View.SeekView = wdHeaderFooterPrimary
    ElseIf (sv = 3) Then
        strWMName = "Section" & i & "_EvenPage_Index" & ActiveDocument.Sections(section_index).Index
        ActiveWindow.ActivePane.View.SeekView = wdHeaderFooterEvenPages
    End If
    
    Selection.HeaderFooter.Shapes(strWMName).Select
    Selection.Delete
    
    Exit Sub
    
ErrHandler:
    'MsgBox "Error in Remove Water Mark [" & section_index & "," & sv & "]"
End Sub

Please kindly advise if you have any idea