How to make a macro print the watermark on all pages! Please help!

[a.fawcett]

I am having so much trouble trying to create a macro to print a
watermark on all pages. If the document is only one page it's fine but
one of our documents is 4 pages. When I print this using the macro it
prints "copy" on the first page, removes the header and footer for the
second page and stamps "copy" on that, and then leaves the header and
footers alone on pages 3 and 4 but does not stamp copy on those last 2
pages!

I just cannot work it out. Please help! Here is my macro code:

Sub PrintCopy()
'
' PrintCopy Macro
' Macro recorded 20/07/2006 by AFawcett
'
With Selection.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(0.68)
.BottomMargin = CentimetersToPoints(2.5)
.LeftMargin = CentimetersToPoints(3.1)
.RightMargin = CentimetersToPoints(3.1)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(0.5)
.FooterDistance = CentimetersToPoints(1.25)
.PageWidth = CentimetersToPoints(21.59)
.PageHeight = CentimetersToPoints(27.94)
.FirstPageTray = wdPrinterUpperBin
.OtherPagesTray = wdPrinterUpperBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = True
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
ActiveDocument.Sections(1).Range.Select
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

Selection.HeaderFooter.Shapes.AddTextEffect(PowerPlusWaterMarkObject1,
_
"DRAFT", "Times New Roman", 1, False, False, 0, 0).Select
Selection.ShapeRange.Name = "PowerPlusWaterMarkObject1"
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
Selection.ShapeRange.Rotation = 315
Selection.ShapeRange.LockAspectRatio = True
Selection.ShapeRange.Height = CentimetersToPoints(6.2)
Selection.ShapeRange.Width = CentimetersToPoints(15.5)
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
Application.PrintOut FileName:="", Range:=wdPrintAllDocument,
Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="",
PageType:=wdPrintAllPages, _
ManualDuplexPrint:=False, Collate:=True, Background:=True,
PrintToFile:= _
False, PrintZoomColumn:=0, PrintZoomRow:=0,
PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
ActiveDocument.Sections(1).Range.Select
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes("PowerPlusWaterMarkObject1").Select
Selection.Delete
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub

 

[Jezebel]

This is the downside of trying to create macros using the macro recorder.
You should use the recorder only to give you an idea of what's required. It
needs a lot of cleaning up before you've got usable code. In this case, all
you need is ---

Dim pSection As Word.Section
Dim pHeaderType As Long

For Each pSection In ActiveDocument.Sections
For pHeaderType = 1 To 3
With
pSection.Headers(pHeaderType).Shapes.AddTextEffect(PowerPlusWaterMarkObject1,
_
"DRAFT", "Times New Roman", 1, False, False, 0, 0)
.TextEffect.NormalizedHeight = False
.Line.Visible = False
.Fill.Visible = True
.Fill.Solid
.Fill.ForeColor.RGB = RGB(192, 192, 192)
.Fill.Transparency = 0
.Rotation = 315
.LockAspectRatio = True
.Height = CentimetersToPoints(6.2)
.Width = CentimetersToPoints(15.5)
.WrapFormat.AllowOverlap = True
.WrapFormat.Side = wdWrapNone
.WrapFormat.Type = 3
.RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
.Left = wdShapeCenter
.Top = wdShapeCenter
End With
Next
Next

 

[a.fawcett]

Thanks very much for that but I can't get it to work. This is what it
looks like: Part of it comes up in red (from pSection.Headers to the
end of False, 0, 0).

Any ideas? I'm a real novice so any help is appreciated. Cheers

Sub PrintCopy()
'
' PrintCopy Macro
' Macro recorded 20/07/2006 by AFawcett
'
Dim pSection As Word.Section
Dim pHeaderType As Long


For Each pSection In ActiveDocument.Sections
For pHeaderType = 1 To 3
With
pSection.Headers(pHeaderType).Shapes.AddTextEffect(PowerPlusWaterMarkObject­1,
_
"DRAFT", "Times New Roman", 1, False, False, 0, 0)
.TextEffect.NormalizedHeight = False
.Line.Visible = False
.Fill.Visible = True
.Fill.Solid
.Fill.ForeColor.RGB = RGB(192, 192, 192)
.Fill.Transparency = 0
.Rotation = 315
.LockAspectRatio = True
.Height = CentimetersToPoints(6.2)
.Width = CentimetersToPoints(15.5)
.WrapFormat.AllowOverlap = True
.WrapFormat.Side = wdWrapNone
.WrapFormat.Type = 3
.RelativeHorizontalPosition =
wdRelativeVerticalPositionMargin
.RelativeVerticalPosition =
wdRelativeVerticalPositionMargin
.Left = wdShapeCenter
.Top = wdShapeCenter
End With
Next
Next

End Sub

 

[Jean-Guy Marcil]

(e-mail address removed) was telling us:
(e-mail address removed) nous racontait que :

Thanks very much for that but I can't get it to work. This is what it
looks like: Part of it comes up in red (from pSection.Headers to the
end of False, 0, 0).

Any ideas? I'm a real novice so any help is appreciated. Cheers

Whenever you copy/paste code form the internet or newsgroups, watch out for
line integrity. If a line was wrapped by a browser, the compiler cannot
reconstitute it.

A red line in the VBE means that it is incomplete or incomprehensible to the
compiler.

The easiest is to make sure that
"With
pSection.Headers(pHeaderType).Shapes.AddTextEffect(PowerPlusWaterMarkObject­1,
_
"DRAFT", "Times New Roman", 1, False, False, 0, 0)
"
is all on one line (Remove the "_").

But that makes for a long line and it can be difficult to
maintain/check/read the code.

So, you are allowed to break lines, but you must use this character sequence
at the end of the line where you want the break:
" _" (a space followed by an underscore character)

So, your line could be:

With pSection.Headers(pHeaderType).Shapes _
.AddTextEffect(PowerPlusWaterMarkObject­1, _
"DRAFT", "Times New Roman", 1, _
False, False, 0, 0)

If it isn't red in the VBE then you are OK.

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

 

[Ernst Scheithauer]

Hi Jezebel,

I tried your macro but the watermark did not appear on all pages (first
page, even/odd page have different headers/footers). Instead all 3 WordArt
Shapes are placed on the odd page on the exact same position.

Is this a bug in the object model? Is there some other error?

 

[Gem_man]

Hi all and in particular Jezabel

I have used Jezabels code for watermarks for a while and all is fine.
I now am trying to use it on an 8 section document but the watermark doesnt
appear after a section that has a table and image on it.

It is also abscent on all pages after the last table and image set.

Any ideas what this could be?

Many thanks
Gem_man

 

[Gem_man]

This is very odd

It transpires that the code is putting all the Cliparts into section 1 on
top of eachother.
Even if I alter the code to place the watermark in section 8 only it still
puts it in section 1.
Altering the header "same as previous" attribute before insertion makes no
difference.

Any ideas?

Gem_man