macros with a watermark

[Laurie]

I have created a macros that creates a watermark and then prints. The macros
will work on the document i create it on but when i use the macro on another
document it does not insert the watermark on each page. Any suggestions is
appreciated.

 

[Graham Mayor]

Post your code!

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Laurie]

I have re-created it and have a different error. I have code posted below.

Sub UNCONROLLED()
'
' UNCONROLLED Macro
' To create an "UNCONTROLLED" watermark on all SOP documents.
'
ActiveDocument.Sections(1).Range.Select
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.AddTextEffect( _
PowerPlusWaterMarkObject222032625, "UNCONTROLLED", "Times New
Roman", 1, _
False, False, 0, 0).Select
Selection.ShapeRange.Name = "PowerPlusWaterMarkObject222032625"
Selection.ShapeRange.TextEffect.NormalizedHeight = False
Selection.ShapeRange.Line.Visible = False
Selection.ShapeRange.Fill.Visible = True
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(192, 192, 192)
Selection.ShapeRange.Fill.Transparency = 0.5
Selection.ShapeRange.Rotation = 315
Selection.ShapeRange.LockAspectRatio = True
Selection.ShapeRange.Height = InchesToPoints(1.31)
Selection.ShapeRange.Width = InchesToPoints(7.85)
Selection.ShapeRange.WrapFormat.AllowOverlap = True
Selection.ShapeRange.WrapFormat.Side = wdWrapNone
Selection.ShapeRange.WrapFormat.Type = 3
Selection.ShapeRange.RelativeHorizontalPosition = _
wdRelativeVerticalPositionMargin
Selection.ShapeRange.RelativeVerticalPosition = _
wdRelativeVerticalPositionMargin
Selection.ShapeRange.Left = wdShapeCenter
Selection.ShapeRange.Top = wdShapeCenter
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub

 

[Graham Mayor]

Unfortunately you cannot always rely on the macro recorder.

Removing the line
Selection.ShapeRange.name = "PowerPlusWaterMarkObject222032625"
should fix it

or cleaned up a bit

Sub Uncontrolled()
Dim sWMarkText As String
sWMarkText = "UNCONTROLLED"
ActiveDocument.Sections(1).Range.Select
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.AddTextEffect(msoTextEffect1, _
sWMarkText, "Times New Roman", 1, False, False, 0, 0).Select
With Selection.ShapeRange
.name = "MyWaterMarkObj001"
.TextEffect.NormalizedHeight = False
.Line.Visible = False
.Fill.Visible = True
.Fill.Solid
.Fill.ForeColor = wdColorGray25
.Fill.Transparency = 0.5
.Rotation = 315
.LockAspectRatio = True
.Height = InchesToPoints(1.31)
.Width = InchesToPoints(7.85)
.WrapFormat.AllowOverlap = True
.WrapFormat.Side = wdWrapNone
.WrapFormat.Type = 3
.RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
.Left = wdShapeCenter
.Top = wdShapeCenter
End With
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Laurie]

Can you please look at the following code? Now when I use it on a new
document it will print the watermark on only 1 page when i have a document
with multiple pages. Thanks

Laurie

Sub UNCONTROLLED()
'
' UNCONTROLLED Macro
'
'
Selection.WholeStory
ActiveDocument.Sections(1).Range.Select
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.AddTextEffect( _
PowerPlusWaterMarkObject14494265, "UNCONTROLLED", "Times New Roman",
1, _
False, False, 0, 0).Select
Selection.ShapeRange.Name = "PowerPlusWaterMarkObject14494265"
Selection.ShapeRange.TextEffect.NormalizedHeight = False
Selection.ShapeRange.Line.Visible = False
Selection.ShapeRange.Fill.Visible = True
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(192, 192, 192)
Selection.ShapeRange.Fill.Transparency = 0.5
Selection.ShapeRange.Rotation = 315
Selection.ShapeRange.LockAspectRatio = True
Selection.ShapeRange.Height = InchesToPoints(1.31)
Selection.ShapeRange.Width = InchesToPoints(7.85)
Selection.ShapeRange.WrapFormat.AllowOverlap = True
Selection.ShapeRange.WrapFormat.Side = wdWrapNone
Selection.ShapeRange.WrapFormat.Type = 3
Selection.ShapeRange.RelativeHorizontalPosition = _
wdRelativeVerticalPositionMargin
Selection.ShapeRange.RelativeVerticalPosition = _
wdRelativeVerticalPositionMargin
Selection.ShapeRange.Left = wdShapeCenter
Selection.ShapeRange.Top = wdShapeCenter
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
ActiveDocument.PrintOut
End Sub

 

[Graham Mayor]

The problems arise as there are three possible headers for each section, and
each header would need to be addressed separately with due regard for
whatever may already be in the header to which you wish to add a watermark.

If I was doing this for myself, I would save the watermark as an autotext
entry (building block in Word 2007) in the normal template (or the document
template) . This eliminates all that formatting on the fly. Then insert the
autotext (building block) entry at the end of each of the header ranges, for
each section, as follows.

If you save the autotext entry in the document template then Instead of
NormalTemplate use ActiveDocument.AttachedTemplate

Sub UncontrolledWord2007()
Dim i As Long
Dim oRange As Range
Dim oBB As BuildingBlock
Set oBB = NormalTemplate.BuildingBlockEntries("UNCONTROLLED")
For i = 1 To ActiveDocument.Sections.Count
Set oRange =
ActiveDocument.Sections(i).Headers(wdHeaderFooterFirstPage).Range
oRange.Collapse wdCollapseEnd
oBB.Insert _
Where:=oRange, _
RichText:=True
Set oRange =
ActiveDocument.Sections(i).Headers(wdHeaderFooterPrimary).Range
oRange.Collapse wdCollapseEnd
oBB.Insert _
Where:=oRange, _
RichText:=True
Set oRange =
ActiveDocument.Sections(i).Headers(wdHeaderFooterEvenPages).Range
oRange.Collapse wdCollapseEnd
oBB.Insert _
Where:=oRange, _
RichText:=True
Next i
End Sub

Sub UncontrolledWord2003()
Dim i As Long
Dim oRange As Range
For i = 1 To ActiveDocument.Sections.Count
Set oRange =
ActiveDocument.Sections(i).Headers(wdHeaderFooterFirstPage).Range
oRange.Collapse wdCollapseEnd
NormalTemplate.AutoTextEntries("UNCONTROLLED") _
.Insert Where:=oRange, _
RichText:=True
Set oRange =
ActiveDocument.Sections(i).Headers(wdHeaderFooterPrimary).Range
oRange.Collapse wdCollapseEnd
NormalTemplate.AutoTextEntries("UNCONTROLLED") _
.Insert Where:=oRange, _
RichText:=True
Set oRange =
ActiveDocument.Sections(i).Headers(wdHeaderFooterEvenPages).Range
oRange.Collapse wdCollapseEnd
NormalTemplate.AutoTextEntries("UNCONTROLLED") _
.Insert Where:=oRange, _
RichText:=True
Next i
End Sub


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>