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!