Insert/Remove Watermark

[Cath_Thomas]

Hi

I noted a very useful post by Lucas on the above topic. I was looking for code for exactly this situation and so copied down the code Lucas has very kindly posted:


Option Explicit
Sub InsertWaterMark()
Dim strWMName As String

On Error Goto ErrHandler
'selects all the sheets
ActiveDocument.Sections(1).Range.Select
strWMName = ActiveDocument.Sections(1).Index
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
'Change the text for your watermark here
Selection.HeaderFooter.Shapes.AddTextEffect(msoTextEffect1, _
"DRAFT", "Arial", 1, False, False, 0, 0).Select
With Selection.ShapeRange

.Name = strWMName
.TextEffect.NormalizedHeight = False
.Line.Visible = False

With .Fill

.Visible = True
.Solid
.ForeColor.RGB = Gray
.Transparency = 0.5
End With

.Rotation = 315
.LockAspectRatio = True
.Height = InchesToPoints(2.42)
.Width = InchesToPoints(6.04)

With .WrapFormat
.AllowOverlap = True
.Side = wdWrapNone
.Type = 3

End With

.RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
.RelativeVerticalPosition = wdRelativeVerticalPositionMargin

'If using Word 2000 you may need to comment the 2
'lines above and uncomment the 2 below.

' .RelativeHorizontalPosition = wdRelativeVerticalPositionPage
' .RelativeVerticalPosition = wdRelativeVerticalPositionPage

.Left = wdShapeCenter
.Top = wdShapeCenter
End With

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

Exit Sub

ErrHandler:
MsgBox "An error occured trying to insert the watermark." & Chr(13) & _
"Error Number: " & Err.Number & Chr(13) & _
"Decription: " & Err.Description, vbOKOnly + vbCritical, "Error"


End Sub


Sub RemoveWaterMark()
Dim strWMName As String

On Error Goto ErrHandler

ActiveDocument.Sections(1).Range.Select
strWMName = ActiveDocument.Sections(1).Index
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes(strWMName).Select
Selection.Delete
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

Exit Sub


ErrHandler:
MsgBox "An error occured trying to remove the watermark." & Chr(13) & _
"Error Number: " & Err.Number & Chr(13) & _
"Decription: " & Err.Description, vbOKOnly + vbCritical, "Error"

End Sub


The code works beautiful when inserting the watermark but unfortunatley only removes the watermark mark from the first page. I've tested this kind of code with documents that contain section breaks and to be honest, I'm not too worried if I can't find code to remove all watermarks from all pages. However, if anyone can help with a basic code to remove watermarks from document (all pages) I'd really appreciate it.

I'm a VBA novice so would be grateful for any help / answers posted.

Many thanks in advance

Cath

[lucas]

Hi Cath, I have attached a file with the code you posted and it seems to work fine on two pages. The code was tested in ver. 2000 and 2003 so you are doing something different than what is in this attachment.

I don't know how it will perform in v 2007 as I currently have no way to test it.

There is a menu next to help to insert and remove the watermark in the attachment.

If it is not a version problem then maybe you have done something else to the document that may be affecting the way it runs. If we can figure out what it is I am sure a solution can be found.

ps. I added vba tags to your post. If you select your code when posting and hit the vba button it will be formatted for the forum.

[Cath_Thomas]

Fab - many thanks Lucas. I'll work through this now. Much appreciated! Like your Les Paul icon btw!

Cath