Macro to print watermark

[BruceM]

Thanks to this group I have code to print the part of a document located
between two bookmarks:

Set r = ActiveDocument.Range( _
Start:=ActiveDocument.Bookmarks("DocStart").End, _
End:=ActiveDocument.Bookmarks("DocEnd").Start)
r.Select
ActiveDocument.PrintOut Range:=wdPrintSelection
Set r = Nothing
Selection.HomeKey unit:=wdStory

I have placed this code into an add-in, and I use an autoexec macro to add a
custom toolbar with a button for running the macro. It works as it should
(although I wish I could get it to print the header and footer, but that may
not be possible, from what I can understand).

However, the main reason for this post is that I would like to add a
watermark to the range of pages being printed. This is some code (abridged
for readability) I created using the macro recorder (except that I changed
"PowerPlusWaterMarkObject1" to "msoTextEffect1").

ActiveDocument.Sections(1).Range.Select
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.AddTextEffect(msoTextEffect1, _
"XYZ Company", "Arial Black", 1, False, False, 0, 0).Select
Selection.ShapeRange.Name = "msoTextEffect1"
Selection.ShapeRange.TextEffect.NormalizedHeight = False
' More Selection.ShapeRange items
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

I can run the macro in the document in which it was created, but I cannot
find the trick to having the macro run in the document containing the
bookmarks. In other words, I open a document, and the Add-In loads with the
code to print between the bookmarks. I can run the macro, and it prints
only the part of the document it should. However, I cannot get it to run
the watermark code on the open document. I expect part of the problem is
that Sections(1) does not apply, and things of that sort, but I can't seem
to sort it all out. Can I run the watermark code along with the code to
print the selection between the bookmarks?

 

[Helmut Weber]

Hi Bruce,

as long as the selection is printed,
no watermark will appear on the paper,
as the watermark is in the header,
which is not in the selection.

You got to find the page number at
the bookmarks start and the pagenumber
at the bookmarks end,
and print the pages it encompasses.

Like that, until better solutions are offered:

Sub temp3()
Dim x1 As Long ' start character of bookmark
Dim x2 As Long ' end character of bookmark
Dim p1 As Long ' start page
Dim p2 As Long ' end page

Dim rTmp As Range
Set rTmp = ActiveDocument.Range
x1 = rTmp.Bookmarks("Test").Range.start
x2 = rTmp.Bookmarks("Test").Range.End
p1 = rTmp.Characters(x1).Information(wdActiveEndPageNumber)
p2 = rTmp.Characters(x1).Information(wdActiveEndPageNumber)

ActiveDocument.PrintOut _
Range:=wdPrintFromTo, From:=CStr(p1), To:=CStr(p2)

End Sub

Seems to work, but I can't test it,
as I don't have a printer at all hereat home.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[BruceM]

Thanks very much for the suggestion. It looks like I will be able to print
the headers and footers, which means I will not need to move them to the
body of the document. That will save me a lot of time.
The code almost worked just as you presented it, except that if the first
bookmark is at the beginning of the document I need to allow for the
possibility that x1 = 0. I could probably avoid that problem by putting the
bookmark somewhere other than the very beginning of the document, but I
think it's better to allow for the possibility. In Access I would have used
the Nz function to allow for the 0, but I used an If statement instead.
I noticed that I need to put the second bookmark somewhere other than the
end of the page, or else I get more pages that I wanted. As I understand,
the code is looking for the page number where the first bookmark is located,
and the page number where the second bookmark is located. The code I ended
up with is:

Dim x1 As Long ' start character of bookmark
Dim x2 As Long ' end character of bookmark
Dim p1 As Long ' start page
Dim p2 As Long ' end page

Dim rTmp As Range
Set rTmp = ActiveDocument.Range
If rTmp.Bookmarks("DocStart").Range.Start = 0 Then
x1 = 1
Else
x1 = rTmp.Bookmarks("DocStart").Range.Start
End If
x2 = rTmp.Bookmarks("DocEnd").Range.End
p1 = rTmp.Characters(x1).Information(wdActiveEndPageNumber)
p2 = rTmp.Characters(x2).Information(wdActiveEndPageNumber)

ActiveDocument.PrintOut _
Range:=wdPrintFromTo, From:=CStr(p1), To:=CStr(p2)

Set rTmp = Nothing

I added the last line because it was in the previous version of the code.
I'm not sure if it's needed.

I tried incorporating the watermark code, but could not get it to work
properly. The watermark ended up in the top left corner of the page, and
was behind everything else (hidden behind a picture, for instance). Again,
that code was something like this:

ActiveDocument.Sections(1).Range.Select
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.AddTextEffect(msoTextEffect1, _
"XYZ Company", "Arial Black", 1, False, False, 0, 0).Select
Selection.ShapeRange.Name = "msoTextEffect1"
Selection.ShapeRange.TextEffect.NormalizedHeight = False
' More Selection.ShapeRange items
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

As I said, I used the macro recorder, so I expect some things in this code
are incorrect, assuming that it is possible at all to add a watermark as I
hope to do. I can use a printer that is able to print a watermark, so it is
not a big problem if I can't add the watermark code, but it would help if
there is a way to add it.

Whatever happens with the watermark, thanks again for the code that lets me
print the header and footer.

 

[Helmut Weber]

Hi Bruce,

it is impossible, to explain all pecularities
about bookmarks and their ranges in one short posting,
but as I see, you've found out yourself.

As to your watermark,
you need to set its properties like:

Selection.ShapeRange(1).Name = "msoTextEffect1"
Selection.ShapeRange(1).TextEffect.NormalizedHeight = False
Selection.ShapeRange(1).Height = 300
Selection.ShapeRange(1).Width = 300
Selection.ShapeRange(1).Top = 300
Selection.ShapeRange(1).Left = 100

which is by far not the optimal solution,
but, for accasional use, it is alright.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[BruceM]

Thanks for your help, but it doesn't work. Here is the full code (minus
error handling). The watermark part of the code was generated by the macro
recorder, and I inserted the code into the other code for printing the
range. I expect that is part of the problem, but this is not Access, so I
am not sure what to do with the VBA code, and there is little documentation
in Help. I changed ShapeRange to ShapeRange(1), which was what you showed,
but the problems are the same either way.

Public Sub PrintIt()

Dim x1 As Long ' start character of bookmark
Dim x2 As Long ' end character of bookmark
Dim p1 As Long ' start page
Dim p2 As Long ' end page

Dim rTmp As Range
Set rTmp = ActiveDocument.Range
If rTmp.Bookmarks("DocStart").Range.Start = 0 Then
x1 = 1
Else
x1 = rTmp.Bookmarks("DocStart").Range.Start
End If
x2 = rTmp.Bookmarks("DocEnd").Range.End
p1 = rTmp.Characters(x1).Information(wdActiveEndPageNumber)
p2 = rTmp.Characters(x2).Information(wdActiveEndPageNumber)

ActiveDocument.Sections(1).Range.Select
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.AddTextEffect(msoTextEffect1, _
"XYZ Company", "Arial Black", 1, False, False, 0, 0).Select
Selection.ShapeRange(1).Name = "msoTextEffect1"
Selection.ShapeRange(1).TextEffect.NormalizedHeight = False
Selection.ShapeRange(1).Line.Visible = False
Selection.ShapeRange(1).Fill.Visible = True
Selection.ShapeRange(1).Fill.Solid
Selection.ShapeRange(1).Fill.ForeColor.RGB = RGB(255, 0, 0)
Selection.ShapeRange(1).Fill.Transparency = 0.5
Selection.ShapeRange(1).Rotation = 315
Selection.ShapeRange(1).LockAspectRatio = True
Selection.ShapeRange(1).Height = InchesToPoints(0.95)
Selection.ShapeRange(1).Width = InchesToPoints(8.21)
Selection.ShapeRange(1).WrapFormat.AllowOverlap = True
Selection.ShapeRange(1).WrapFormat.Side = wdWrapNone
Selection.ShapeRange(1).WrapFormat.Type = 3
Selection.ShapeRange(1).RelativeHorizontalPosition =
wdRelativeHorizontalPositionPage
Selection.ShapeRange(1).RelativeVerticalPosition =
wdRelativeVerticalPositionPage
Selection.ShapeRange(1).Left = wdShapeCenter
Selection.ShapeRange(1).Top = wdShapeCenter
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

ActiveDocument.PrintOut _
Range:=wdPrintFromTo, From:=CStr(p1), To:=CStr(p2)

Set rTmp = Nothing

End Sub

I am getting runtime error 91 "Object Variable or With Block variable not
set" on the line:
Selection.HeaderFooter.Shapes.AddTextEffect(msoTextEffect1, _
"XYZ Company", "Arial Black", 1, False, False, 0, 0).Select

Creating the watermark in this way may be something Word cannot do reliably.
If that is the case, I can set up a printer to use a watermark. Being able
to print the header and footer for a range of pages was the main thing I
wanted to do. I can create a watermark without using Word, if necessary.
If there is a way to generate it through code, that would be the best, but
it is not essential.

 

[Helmut Weber]

Hi Bruce,

if something goes wrong when running the macro,
and you try to run the macro again,
it may be, that there is a shaperange
left over from your previous attempt.

Make sure first, that there is no shaperange left
in your header, before trying again.

Or count the shaperanges in your header, like
MsgBox
ActiveDocument.StoryRanges(wdPrimaryHeaderStory).ShapeRange.Count
and if there are more than there were before,
delete the last one.

If you got two shaperanges, which are alright,
and you try to insert the watermark,
the watermark would be shaperange(3) or

ActiveDocument.StoryRanges(wdPrimaryHeaderStory).ShapeRange.Count +1


It is terribly complicated
and frankly speaking,
I think I don't get all of it.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Helmut Weber]

....
and there is the ZOrder-property of the shaperange,
which the macrorecorder ignores or doesn't record, at it seems.

The ZOrder defines, if shaperanges are on top of each other,
which will be where in third dimension (z),
or simply speaking, which will be on top.

HTH

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[BruceM]

Thanks for the suggestions. However, I could not get the Count expression
to work. When I tried to compile, "Count" was highlighted, and the message
was "invalid use of property".
It is clearly very complex, and I suspect that if I ever get it working it
will be unstable on other computers. I think I need to accept Word's
limitations with things like this, and just use the printer to create the
watermark.
Your code to print the selection along with the header and the footer will
be very useful, and save a lot of time that I thought I would have to spend
moving the header and footer to the main part of the document. Thank you
again for your interest in my question, and for the valuable assistance you
have provided.