工作中经常遇到需要删除多个文档页眉页脚的情况,手动删除很麻烦,专门写了一个程序来批量删除。很方便。

如何批量删除word的页眉页脚?_页眉

代码:

Sub 删除页眉页脚()
    docpath = getpath
    If IsEmpty(docpath) Then Exit Sub
    Dim wd As Document
    Application.DisplayAlerts = wdAlertsNone
    For i = 1 To UBound(docpath)
        Set wd = Documents.Open(docpath(i))
        'For Each oSec In wd.Sections                           '文档的节中循环
        'Set myrange = oSec.Headers(wdHeaderFooterPrimary).Range
        'myrange.Delete                                     '删除页眉中的内容
        'Set myrange2 = oSec.Footers(wdHeaderFooterPrimary).Range
        'myrange2.Delete                                    '删除页脚中的内容
        'Next
        For sec = 1 To wd.Sections.Count
            Selection.GoTo wdGoToSection, wdGoToAbsolute, sec
            With wd.Sections(sec)
                '/首页页眉
                Set oHF = .Headers(wdHeaderFooterFirstPage)
                oHF.Range.Delete
                '//////////////////奇数页页眉//////////////////////////
                Set oHF = .Headers(wdHeaderFooterPrimary)
                oHF.Range.Delete
                '/////////////////////////////////////////////////////
                '/偶数页页眉
                Set oHF = .Headers(wdHeaderFooterEvenPages)
                oHF.Range.Delete
                '/首页页脚
                Set oHF = .Footers(wdHeaderFooterFirstPage)
                oHF.Range.Delete
                '/奇数页页脚
                Set oHF = .Footers(wdHeaderFooterPrimary)
                oHF.Range.Delete
                '/偶数页页脚
                Set oHF = .Footers(wdHeaderFooterEvenPages)
                oHF.Range.Delete
            End With
            With wd.ActiveWindow.ActivePane.View
                .SeekView = wdSeekCurrentPageHeader            '进入当前页面的页眉
                Selection.WholeStory
                Selection.Delete
                .SeekView = wdSeekCurrentPageFooter            '进入当前页面的页脚
                Selection.WholeStory
                Selection.Delete
                .SeekView = wdSeekMainDocument                 '退出页眉页脚视图
            End With
            If wd.Sections(sec).Headers(wdHeaderFooterPrimary).Range.ParagraphFormat.Borders(wdBorderBottom).LineStyle = 1 Then
                wd.Sections(sec).Headers(wdHeaderFooterPrimary).Range.ParagraphFormat.Borders(wdBorderBottom).LineStyle = 0
                With wd.ActiveWindow.ActivePane.View
                    .SeekView = wdSeekCurrentPageHeader        '进入当前页面的页眉
                    .SeekView = wdSeekMainDocument             '退出页眉页脚视图
                End With
            End If
        Next
        wd.Close True
    Next
    Application.DisplayAlerts = wdAlertsAll
    MsgBox "完成!"
End Sub
Function getpath(Optional FileStyle$ = "*.doc*")
    '//自定义函数的作用:弹出对话框,让用户选择一个txt文件,函数返回一个数组,里面存储txt的路径
    Dim fd As FileDialog, vrtSelectedItem
    Dim xrr() As String, X&
    Set fd = Application.FileDialog(msoFileDialogFilePicker)   '弹出选择对话框
    With fd
        .ButtonName = "已选择"
        .AllowMultiSelect = True                               '不允许多选
        .InitialFileName = ActiveDocument.Path                 '初始路径是当前文档的路径
        .Filters.Add "Word文档", FileStyle, 1                    '展示的后缀筛选
        '.FilterIndex = 2
        If .Show <> -1 Then Exit Function
        For Each vrtSelectedItem In .SelectedItems
            X = X + 1
            ReDim Preserve xrr(1 To X)
            xrr(X) = vrtSelectedItem
        Next
    End With
    Set fd = Nothing                                           '清空对象
    If X > 0 Then getpath = xrr
End Function


该段代码可以实现一键删除多个文档的页眉页脚,保存记录~