Word deleting watermarks in headers

[diana]

Hi

Macropods provided sample code to insert and delete watermarks from Word documents headers.
http://www.eileenslounge.com/viewtopic. ... 402#p51402" onclick="window.open(this.href);return false;

Ive converted the code from vba to vb.net

The Sub Delete_Watermarks() works and removes if only one watermark in the header.

Ive discovered the document may contain 2 or more watermarks in the header. which means running Delete_Watermarks() deletes one instance of the watermark.

if I run Delete_Watermarks() it deletes the 2nd instance of the watermark headers.

or if there are 3 watermarks , I run Delete_Watermarks() a third time and it deletes the watermarks in the headers.

THe shape collection count gets thrown /errors if I delete the shp.

It was suggested to count backwards using

For counter = shps.Count To 1 Step -1

but ive not used this before and im not sure how/where that would fit in the code.

ive added the line but it errors. I need to define the range first, but again I dont knwow where the line would be defined?

ive attached the code:

any ideas?

many thanks

dd

heres the orginial code:

Code: Select all

Sub delete_Watermarks1()

Dim doc As Word.Document
Dim scn As Word.Section
Dim shp As Word.shape
Dim hdft As Word.HeaderFooter
Dim shps As Word.Shapes

         With ActiveDocument
                For Each scn In .Sections
                    For Each hdft In scn.Headers
                        For Each shp In hdft.Range.ShapeRange
                            If InStr(1, shp.AlternativeText, "CORRS") <> 0 Then
                                MsgBox(shp.Name & " shp.AlternativeText = " & shp.AlternativeText
                                'shp.Delete()
                            End If
                        Next shp
                    Next hdft
                Next scn
           End With

end sub

heres the amended code:

Code: Select all

Sub delete_Watermarks2()

Dim doc As Word.Document
Dim scn As Word.Section
Dim shp As Word.shape
Dim hdft As Word.HeaderFooter
Dim shps As Word.Shapes

    With ActiveDocument
             For Each scn In .Sections
                 For Each hdft In scn.Headers
                 
                 Set shps = hdft.Range.ShapeRange
                 
                     'For Each shp In hdft.Range.ShapeRange                    
  
                     For counter = shps.Count To 1 Step -1    'here?

                          If InStr(shps(counter).AlternativeText, "CORRS") > 0 Then
                                 shps(counter).Delete
                         End If
                     
                     Next
                 Next hdft
             Next scn
        End With

end sub

[jec]

Hi Diana

I've have observed one must remove watermark(shape) from each section. Code below works for me in Word 2010.

Sub DeleteWaterMark()
Dim hdft As HeaderFooter
Dim oShape As Word.Shape
Dim Title As String
Dim Msg As String
Title = "Delete Watermarks"

On Error Resume Next

'Show msg - stop if user does not click Yes
Msg = "This macro deletes watermarks. " & vbCr & vbCr & _
"Do you want to continue?"

If MsgBox(Msg, vbYesNo + vbQuestion, Title) <> vbYes Then
Exit Sub
End If

Set hdft = ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage)
Set oShape = hdft.Shapes(1)
oShape.Delete
Set hdft = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary)
Set oShape = hdft.Shapes(1)
Set hdft = ActiveDocument.Sections(1).Headers(wdHeaderFooterEvenPages)

Set oShape = hdft.Shapes(1)

oShape.Delete
End Sub