VBA Help (novice user)

[Caster_Keller]

Hi

My apologies if this isn't the correct forum - I previously posted this
question on the Office Developer area of this site but not many seem to visit
/ respond!

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
VBS 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

 

[Caster_Keller]

**************************************

APOLOGIES - POSTED THIS NOTE A SECOND TIME AS I WAS NOTIFIED OF AN ERROR THE
FIRST TIME - TOOK A WHILE FOR THE FIRST POST TO BE PUBLISHED. APOLOGIES AGAIN.

**************************************