The template I am creating will be used on Word version 97 - upwards

I have concocted the below code will the help of participants on the
newsgroups which places a different watermark on 3 copies of 1 document.  For
some reason though, despite having set the formfields to noreset they are
still doing so, when i don't want them to!

Can anyone help me with a solution, please?

Here is the code:

Option Explicit
Dim GetText As String

Sub SetupWaterMark()

GetText = "Current holders copy"
   
   If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
       ActiveWindow.Panes(2).Close
   End If
   If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
       ActivePane.View.Type = wdOutlineView Or
ActiveWindow.ActivePane.View.Type _
        = wdMasterView Then
       ActiveWindow.ActivePane.View.Type = wdPageView
   End If
   ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
   Selection.HeaderFooter.Shapes.AddTextEffect(msoTextEffect2, _
       GetText, "Arial", 72#, msoFalse, msoFalse, 280.3, 320.4). _
       Select
   
   Selection.HeaderFooter.Shapes(1).Select
   Selection.ShapeRange.Fill.Visible = msoTrue
   Selection.ShapeRange.Fill.Solid
   Selection.ShapeRange.Fill.ForeColor.RGB = RGB(192, 192, 192)
   Selection.ShapeRange.Fill.Transparency = 0#
   Selection.ShapeRange.Line.Weight = 0.75
   Selection.ShapeRange.Line.DashStyle = msoLineSolid
   Selection.ShapeRange.Line.Style = msoLineSingle
   Selection.ShapeRange.Line.Transparency = 0#
   Selection.ShapeRange.Line.Visible = msoTrue
   Selection.ShapeRange.Line.ForeColor.RGB = RGB(192, 192, 192)
   Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
   Selection.ShapeRange.LockAspectRatio = msoFalse
   Selection.ShapeRange.Height = 180.55
   Selection.ShapeRange.Width = 501.75
   Selection.ShapeRange.Rotation = 320#
   Selection.ShapeRange.RelativeHorizontalPosition = _
       wdRelativeHorizontalPositionColumn
   Selection.ShapeRange.RelativeVerticalPosition = _
       wdRelativeVerticalPositionParagraph
   Selection.ShapeRange.IncrementLeft -220
   Selection.ShapeRange.LockAnchor = False
   Selection.ShapeRange.WrapFormat.Type = wdWrapNone
   Selection.ShapeRange.WrapFormat.Side = wdWrapBoth
   Selection.ShapeRange.WrapFormat.DistanceTop = CentimetersToPoints(0)
   Selection.ShapeRange.WrapFormat.DistanceBottom = CentimetersToPoints(0)
   Selection.ShapeRange.WrapFormat.DistanceLeft = CentimetersToPoints(0.32)
   Selection.ShapeRange.WrapFormat.DistanceRight = CentimetersToPoints(0.32)
   ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

End Sub

Sub PrintCopies()

Dim MyBackgroundOptions As Boolean
Dim GetNumber As String
Dim i As Long

Application.ScreenUpdating = False

Call ToolsProtectUnprotectDocument
Call SetupWaterMark

MyBackgroundOptions = Options.PrintBackground
Options.PrintBackground = False

Do
   GetNumber = 3

Loop While Not IsNumeric(GetNumber) And Not GetNumber = ""

If GetNumber = "" Then GoTo LeaveSub

For i = 1 To CLng(GetNumber)
   
   Select Case i
   
   Case Is = 1
   GetText = "Current holders copy"
   
   ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
   Selection.HeaderFooter.Shapes(1).TextEffect.Text = GetText
   ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

   Case Is = 2
   GetText = "Collectors copy"
   
   ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
   Selection.HeaderFooter.Shapes(1).TextEffect.Text = GetText
   ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
   
   Case Is = 3
   GetText = "Disposal site copy"
   
   ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
   Selection.HeaderFooter.Shapes(1).TextEffect.Text = GetText
   ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
   
   Case Else
   
   End Select
   
   If Not GetText = "" Then
       Myprintout GetText
   End If

Next

LeaveSub:
Options.PrintBackground = MyBackgroundOptions

   GetText = ""
   
   ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
   Selection.HeaderFooter.Shapes(1).TextEffect.Text = GetText
   ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

Call ProtectForm

Application.ScreenUpdating = True

End Sub

Sub ToolsProtectUnprotectDocument()

Dim oDoc As Document
Set oDoc = ActiveDocument

On Error GoTo ErrMess
If oDoc.ProtectionType = wdNoProtection Then
   With Dialogs(wdDialogToolsProtectDocument)
       .noreset = True
       .Show
   End With
Else
   oDoc.Unprotect Password:="maw3327"
End If
Exit Sub

ErrMess:
   MsgBox Err.Description, vbInformation

End Sub

Sub ProtectForm()
   If ActiveDocument.ProtectionType = wdAllowOnlyFormFields Then
       ActiveDocument.Unprotect Password:="maw3327"
   Else
       ActiveDocument.Protect Password:="maw3327",
Type:=wdAllowOnlyFormFields, noreset:=True
   End If
End Sub

Function Myprintout(FieldText As String) As Boolean

With ActiveDocument
   
    .PrintOut

End With

End Function

----------------
Mark