|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Watermark on every page of document which has different first/odd/even page headers
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 |
#2
|
||||
|
||||
This thread is effectively a duplicate of: https://www.msofficeforums.com/word-...tml#post136156
Kindly don't ask questions on the same issue in multiple threads. Thread closed. You may continue the discussion in your original thread.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Watermark Breaking Up on one page of Multipage Document | Mandy Chalmers | Word | 7 | 05-15-2014 01:48 PM |
2 page document printing problem, text from page 1 in layout of page 2 when printed | laurawether45 | Word | 1 | 08-02-2012 07:03 AM |
Watermark deletes headers | ChrisDevrell | Word | 1 | 05-01-2012 07:23 AM |
How do I make a whole page watermark? | Yallambie | Word | 1 | 07-14-2011 08:12 PM |
Printing multiple page worksheet with watermark | zany | Excel | 2 | 11-27-2009 01:33 AM |