Why my watermark are placed in different positions in some pages?

shanlau · #1 12-03-2018, 07:56 PM

I have added the watermark in all pages of the document by VBA code. The code works fine in simple case but doesn't work well if there is long table across pages.
I have tested it in word2010 and office365, the results are slightly different but both of them are not ideal

result in word2010

result in word o365

Here is my code:

Code:

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

Hope someone can help me to resolve the positioning issue

Guessed · #2 12-03-2018, 10:54 PM

Repeating the object on every page is heavily dependent on the anchor paragraph staying put.

Watermarks should be added to the header or footer so they only get added for each section break instead of each page.

shanlau · #3 12-04-2018, 01:51 AM

Quote:

Originally Posted by Guessed

Repeating the object on every page is heavily dependent on the anchor paragraph staying put.

Watermarks should be added to the header or footer so they only get added for each section break instead of each page.

Thank you for suggestion.
I have tried to use the header to add watermark but got the following problem
In the user document, there are multiple sections with different first/odd/even page.
My code works fine if all sections has event number in total pages, but get strange result if there is odd total page number in some sections. Some watermarks are overlapped while some of them are missing.

Here is my code:

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

Appreciate if someone can advise how to correct it!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Page numbers in different positions	NugentS	Word	3	12-04-2018 01:24 AM
Different watermark in different pages	ABCNN	Drawing and Graphics	2	10-27-2017 08:44 AM
Insert picture over watermark that still shows watermark	Nick B	Word	4	11-21-2016 01:42 AM
VBA code to add watermark in all pages	Ajay2506	Word VBA	2	06-16-2016 08:33 PM
Watermark not on all pages	treadhead194	Word	2	04-29-2015 05:25 AM