Macro to remove a watermark

[Jcericola]

I wrote a simple macro to add a watermark to my document. Now I'm trying to
write one to delete the watermark. The code works on the first Watermark I
insert and delete, but subsequent ones give me an error "The item with the
specified name was not found". I beleive the problem is that word wants to
reference the object by name, but if the name of the item is different
everytime you reinsert a new watermark. Please help me find a way to delete
my watermark. Here is my code. It is the second macro that fails.

Sub InsertWatermark_Draft()

If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Application.DisplayAutoCompleteTips = True
NormalTemplate.AutoTextEntries("Watermark_Draft").Insert
Where:=Selection. _
Range, RichText:=True
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

End Sub

Sub RemoveWatermark_Draft()

If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes("Text Box 2").Select
Selection.ShapeRange.Delete
Selection.Delete Unit:=wdCharacter, Count:=1

End Sub

 

[Greg]

I am just taking a stab at this. I think you could do this if you put
your watermark in an AutoText field. Then when you want to delete you
could then simply delete the AutoText fields found in the defined
range.

Sub InsertWatermark_Draft()

If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldAutoText,
Text:= _
"Water_Mark", PreserveFormatting:=True
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument


End Sub
Sub RemoveWatermark_Draft()

Dim oFld As Field
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.WholeStory
For Each oFld In Selection.Range.Fields
If oFld.Type = wdFieldAutoText Then
oFld.Delete
End If
Next
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub

If anyone can offer a better way to set the range to the wholestory
range I would appreciate feedback.

 

[Jezebel]

You'll make your life much easier if you don't do all that mucking around
with windows, panes, and views -- just work directly with the objects
themselves. To insert the watermark:

Sub InsertWatermark_Draft()
NormalTemplate.AutoTextEntries("Watermark_Draft").Insert _
Where:=ActiveDocument.StoryRanges(wdPrimaryHeaderStory), _
RichText:=True
End Sub

To delete it, assuming you don't have other shapes in your header --

Sub RemoveWatermark_Draft()

With ActiveDocument.StoryRanges(wdPrimaryHeaderStory)
Do Until .Shapes.Count = 0
.Shapes(1).Delete
Loop
End with

End sub

 

[Jcericola]

What if I do have other objects in my header?

You'll make your life much easier if you don't do all that mucking around
with windows, panes, and views -- just work directly with the objects
themselves. To insert the watermark:

Sub InsertWatermark_Draft()
NormalTemplate.AutoTextEntries("Watermark_Draft").Insert _
Where:=ActiveDocument.StoryRanges(wdPrimaryHeaderStory), _
RichText:=True
End Sub

To delete it, assuming you don't have other shapes in your header --

Sub RemoveWatermark_Draft()

With ActiveDocument.StoryRanges(wdPrimaryHeaderStory)
Do Until .Shapes.Count = 0
.Shapes(1).Delete
Loop
End with

End sub

 

[Jcericola]

this code is not working for me. as soon as I copy it into word the line
"Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldAutoText,
Text:= _
"Water_Mark", PreserveFormatting:=True" goes red and the debug says I have
a syntax error. Please help.

 

[Jezebel]

Then you'll need to examine the shapes individually to determine which one
you want to delete. Insert the watermark and check the properties -- there
will be some that are sufficiently distinctive, such as type or position.
But you can't use the Name (which is what your original code was using)
because that's not reliable: it depends on the sequence of events in
creating the document.


maybe something like

Dim pShape as Word.Shape

For each pShape in
ActiveDocument.StoryRanges(wdPrimaryHeaderStory).Shapes
if pShape.top = 123 and pShape.Left = 456 then
pShape.Delete
Exit for
end if
Next