Microsoft Office Forums Why my watermark are placed in different positions in some pages?

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 12-03-2018, 07:56 PM
shanlau shanlau is offline Why my watermark are placed in different positions in some pages? Windows 10 Why my watermark are placed in different positions in some pages? Office 2010
Novice
Why my watermark are placed in different positions in some pages?
 
Join Date: Dec 2018
Posts: 3
shanlau is on a distinguished road
Default Why my watermark are placed in different positions in some pages?

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
Reply With Quote
  #2  
Old 12-03-2018, 10:54 PM
Guessed's Avatar
Guessed Guessed is offline Why my watermark are placed in different positions in some pages? Windows 10 Why my watermark are placed in different positions in some pages? Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 1,280
Guessed has a spectacular aura aboutGuessed has a spectacular aura aboutGuessed has a spectacular aura about
Default

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.
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #3  
Old 12-04-2018, 01:51 AM
shanlau shanlau is offline Why my watermark are placed in different positions in some pages? Windows 10 Why my watermark are placed in different positions in some pages? Office 2010
Novice
Why my watermark are placed in different positions in some pages?
 
Join Date: Dec 2018
Posts: 3
shanlau is on a distinguished road
Default

Quote:
Originally Posted by Guessed View Post
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!
Reply With Quote
Reply

Thread Tools
Display Modes


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


All times are GMT -7. The time now is 10:51 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2019 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft