论坛启用新域名www.gzhucm.com，请继续支持我们
切换到宽版
发帖 回复
返回列表
  • 2498阅读
  • 0回复

利用VBA批量删除文件夹里面所有word文件中的页眉、页脚、页码 [复制链接]

 上一主题 下一主题
离线yuze1981
管理员
 
只看楼主 倒序阅读 0  发表于: 2014-10-22
网上的VBA只支持word2003，这里参照修改了一下，经测试word 2010有效

首先打开一个任意word文档，视图--宏--查看宏
创建一个，在代码窗黏贴下面代码

复制代码
  1. Sub 批量删除文件夹里面所有Word文档的页眉页脚()
  2. Dim Fdlg As FileDialog, Fl
  3. Dim Fso, Fld, Fln, Wk
  4. Set Fdlg = Application.FileDialog(msoFileDialogFolderPicker)
  5. With Fdlg
  6.      .Title = "选择要处理目标文件夹" & "——(删除里面所有Word文档的页眉页脚)"
  7.         If .Show = -1 Then
  8.           MyPath = .SelectedItems(1)
  9.         Else
  10.           Exit Sub
  11.     End If
  12.   End With
  13. Set Fso = CreateObject("Scripting.FileSystemObject")
  14. Set Fld = Fso.GetFolder(MyPath)
  15. Set Fln = Fld.Files
  16. For Each Wk In Fln
  17.     Set myDoc = Documents.Open(FileName:=Fld & "\" & Wk.Name)
  19. If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
  20.         ActiveWindow.Panes(2).Close
  21.     End If
  22.     If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
  23.         ActivePane.View.Type = wdOutlineView Then
  24.         ActiveWindow.ActivePane.View.Type = wdPrintView
  25.     End If
  26.     ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
  27.     Selection.WholeStory
  28.     Selection.Delete Unit:=wdCharacter, Count:=1
  29.     Selection.WholeStory
  30.     With Selection.ParagraphFormat
  31.         .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
  32.         .Borders(wdBorderRight).LineStyle = wdLineStyleNone
  33.         .Borders(wdBorderTop).LineStyle = wdLineStyleNone
  34.         .Borders(wdBorderBottom).LineStyle = wdLineStyleNone
  35.         With .Borders
  36.             .DistanceFromTop = 1
  37.             .DistanceFromLeft = 4
  38.             .DistanceFromBottom = 1
  39.             .DistanceFromRight = 4
  40.             .Shadow = False
  41.         End With
  42.     End With
  43.     With Options
  44.         .DefaultBorderLineStyle = wdLineStyleSingle
  45.         .DefaultBorderLineWidth = wdLineWidth075pt
  46.         .DefaultBorderColor = wdColorAutomatic
  47.     End With
  48.     If Selection.HeaderFooter.IsHeader = True Then
  49.         ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
  50.     Else
  51.         ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
  52.     End If
  53.     Selection.WholeStory
  54.     Selection.Delete Unit:=wdCharacter, Count:=1
  55.     ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
  56.     Selection.Sections(1).Footers(1).PageNumbers.Add PageNumberAlignment:= _
  57.         wdAlignPageNumberRight, FirstPage:=True
  58. ' 以上可以换成是你自己录制的宏
  59. ' C公共部分的代码
  60. Application.DisplayAlerts = False '强制执行“是”
  61. 'ActiveDocument.Saved = True'强制执行“否”
  62. ActiveDocument.Close '退出
  64. Next
  65. End Sub


成功
回复
举报
分享到 淘江湖 新浪 QQ微博 QQ空间 开心 人人 豆瓣 网易微博 百度 鲜果 白社会 飞信
发帖 回复
返回列表