VBA Help (for a novice)

[Caster_Keller]

Hi

My apologies if this isn't the correct forum - I have already posted to the
Office Developer section of this community but this doesn't seem very well
used. I'm looking for help on what's probably a very basic problem: I've
found some code to insert and remove the wording "Draft" (as a watermark) on
a Word 2003 document - I've actually saved the macros into the normal.dot (at
C:\progfiles\microsoftoffice\templates). The insert part of the macro works
like a dream - I've created buttons and keyboard shortcuts and the insert
tool inserts "Draft" on every page as expected. However, the remove coding
doesn't seem to work as well. If I have a letter with "Draft" on every page,
when run, the marco only sees to remove the watermak on page 1. I've tried
highlighting the whole doc and then running the macro but to no avail.

Would someone please be able to help me with this - I know very little about
VBA but am posting the code for your information. Many thanks in advance.

Code:

Option Explicit
Sub InsertWaterMark()
Dim strWMName As String

On Error GoTo ErrHandler
'selects all the sheets
ActiveDocument.Sections(1).Range.Select
strWMName = ActiveDocument.Sections(1).Index
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
'Change the text for your watermark here
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 = wdRelativeVerticalPositionMargin
.RelativeVerticalPosition = wdRelativeVerticalPositionMargin

'If using Word 2000 you may need to comment the 2
'lines above and uncomment the 2 below.

' .RelativeHorizontalPosition = wdRelativeVerticalPositionPage
' .RelativeVerticalPosition = wdRelativeVerticalPositionPage

.Left = wdShapeCenter
.Top = wdShapeCenter
End With

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 RemoveWaterMark()
Dim strWMName As String

On Error GoTo ErrHandler

ActiveDocument.Sections(1).Range.Select
strWMName = ActiveDocument.Sections(1).Index
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes(strWMName).Select
Selection.Delete
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