使用 Excel VBA 删除 Word 文档中的水印

Question

I am trying to use excel to delete a watermark in all areas of a word document. I was able to do so with VB in Word, and I have translated that code over to excel to reach out to word to complete. There are no errors, but the code is not able to delete or remove the watermark. I believe there must be some additional link to the shape or location of it that I need to reference, but I don't know what it would be missing.

The working code in Word VBA used spShape.Visible = False which did not do anything in excel, and I have tried spShape.Delete to no avail either.

Any Help is appreciated, here is my code:

Sub AddRemoveWatermark()
'Word Variables
Dim wrdApplication As Word.Application
Dim wrdDocument As Word.Document
Dim wrdSection As Word.section
Dim wrdHeader As Word.HeaderFooter
Dim rngHeader As Word.Range
Dim spShape As Word.Shape

Dim strDocumentName As String
Dim strPath As String
Dim strBBPath As String
Dim lngCount As Long
Dim pHeaderType As Long
Dim strShapeName As String

' Open the file dialog
With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = True
    .Show

    Set wrdApplication = New Word.Application

    ' Display paths of each file selected
    For lngCount = 1 To .SelectedItems.Count
        strPath = .SelectedItems(lngCount)
        Set wrdDocument = wrdApplication.Documents.Open(strPath)

        strDocumentName = wrdDocument.FullName 'Record the document name
        wrdApplication.Templates.LoadBuildingBlocks

        wrdApplication.Visible = True

            'Address each section
            For Each wrdSection In wrdDocument.Sections
                With wrdSection
                    Set rngHeader = .Headers(wdHeaderFooterFirstPage).Range
                    For Each spShape In rngHeader.ShapeRange
                        strShapeName = spShape.Name

                        If InStr(strShapeName, "PowerPlusWaterMarkObject") > 0 Then
                            'spShape.Delete
                            spShape.Visible = msoFalse
                        End If
                    Next

                    Set rngHeader = .Headers(wdHeaderFooterPrimary).Range

                    For Each spShape In rngHeader.ShapeRange
                        strShapeName = spShape.Name

                        If InStr(strShapeName, "PowerPlusWaterMarkObject") > 0 Then
                            'spShape.Delete
                            spShape.Visible = msoFalse
                        End If
                    Next

                End With
            Next wrdSection

            wrdDocument.SaveAs (wrdDocument.FullName)

        wrdDocument.Close
    Next lngCount
End With

wrdApplication.Quit

End Sub

Answer 1

Hey is my code for removing watermark, not so elegant though.

Sub RemoveWordArtWaterMark()
'on error resume next
On Error Resume Next
'from google group
Dim x           As Long
For x = 1 To 20
    ActiveDocument.sections(1).Headers(wdHeaderFooterFirstPage).Shapes(1).Delete
Next x

End Sub