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

Guessed · #1 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 · #2 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