工作中经常遇到需要删除多个文档页眉页脚的情况,手动删除很麻烦,专门写了一个程序来批量删除。很方便。
代码:
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
该段代码可以实现一键删除多个文档的页眉页脚,保存记录~