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

【问题标题】：Deleting Watermark in Word Document using Excel VBA使用 Excel VBA 删除 Word 文档中的水印
【发布时间】：2020-08-23 20:30:51
【问题描述】：

我正在尝试使用 excel 删除 word 文档所有区域中的水印。我可以在 Word 中使用 VB 来做到这一点，并且我已经将该代码翻译成 excel 以接触到 word 来完成。没有错误，但代码无法删除或移除水印。我相信必须有一些额外的链接指向我需要参考的它的形状或位置，但我不知道它会丢失什么。

Word VBA 中的工作代码使用了 spShape.Visible = False，它在 excel 中没有做任何事情，我也试过 spShape.Delete 也无济于事。

感谢任何帮助，这是我的代码：

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

【问题讨论】：

适用于我尝试过的默认 ms 字水印。
你是对的，我可以复制。这意味着它不适用于我正在做的 VB 放置水印。任何人都可以帮助了解 VB 放置的水印有什么不同吗？这是我用来将它放在每个标题末尾的代码部分。 wrdApplication.Templates(strBBPath).BuildingBlockEntries(strBBName).Insert Where:=rngHeader, RichText:=True
为了让它工作，我更新了它，如果 spShape.Type = msoTextEffect 也删除。我相信水印没有保存在正常的水印布局中，而是某种艺术字对象。这更像是一种解决方法，因为我仍然不知道为什么它没有以正常的水印方式保存以允许删除。

标签： excel ms-word watermark vba

【解决方案1】：

嘿是我的去除水印的代码，虽然不是很优雅。

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

结束子

【讨论】：