Resetting form fields

[Mark]

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

 

[Doug Robbins - Word MVP]

To protect the document, use

ODoc.Protect wdAllowOnlyFormfields, NoReset

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[Mark]

Doug,

This doesn't work either.

Can you or anyone else suggest anything else, it seems to be when the header
and footers are opened that it looses all the text in the fields!

 

[Jean-Guy Marcil]

Mark was telling us:
Mark nous racontait que :

Doug,

This doesn't work either.

Can you or anyone else suggest anything else, it seems to be when the
header and footers are opened that it looses all the text in the
fields!

Do not open the header/footer unless you really have to.

In this case you definitely do not need to.
The selection object can cause all kinds of undesired side-effects, as you
have experienced.
I personally avoid it like the pest.

Try this version of your code in which there is no need to activate the
header window at all.
Notice the use of the With - End With blocks that make the code run faster
and easier to read/maintain.

(You may need to change
wdHeaderFooterPrimary
to either
wdHeaderFooterEvenPages
or
wdHeaderFooterFirstPage
depending on your situation.)


Option Explicit
Dim GetText As String

Sub SetupWaterMark()

Dim myShape As Shape

GetText = "Current holders copy"

Set myShape = Selection.Sections(1).Headers(wdHeaderFooterPrimary) _
.Shapes.AddTextEffect(msoTextEffect2, GetText, "Arial", 72#, _
msoFalse, msoFalse, 280.3, 320.4)

With myShape
With .Fill
.Visible = msoTrue
.Solid
.ForeColor.RGB = RGB(192, 192, 192)
.Transparency = 0#
End With
With .Line
.Weight = 0.75
.DashStyle = msoLineSolid
.Style = msoLineSingle
.Transparency = 0#
.Visible = msoTrue
.ForeColor.RGB = RGB(192, 192, 192)
.BackColor.RGB = RGB(255, 255, 255)
End With
.LockAspectRatio = msoFalse
.Height = 180.55
.Width = 501.75
.Rotation = 320#
.RelativeHorizontalPosition = _
wdRelativeHorizontalPositionColumn
.RelativeVerticalPosition = _
wdRelativeVerticalPositionParagraph
.IncrementLeft -220
.LockAnchor = False
With .WrapFormat
.Type = wdWrapNone
.Side = wdWrapBoth
.DistanceTop = CentimetersToPoints(0)
.DistanceBottom = CentimetersToPoints(0)
.DistanceLeft = CentimetersToPoints(0.32)
.DistanceRight = CentimetersToPoints(0.32)
End With
End With

End Sub



--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org