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

时间:2017-03-10 17:07:24

标签: excel-vba ms-word watermark vba excel

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

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

1 个答案:

答案 0 :(得分:0)

嘿,这是我删除水印的代码,虽然不太好。

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

结束子

相关问题