论坛 › ＰＣ数码 › 批量修改word，excel页眉页脚内容求助

鸟瞰的坠途 发表于 2017-12-29 14:03

批量修改word，excel页眉页脚内容求助

有几千个文档资料需要批量修改页眉页脚里的部分内容，找了一大堆各种软件测试。只有WordPipe能够满足需求，一看注册价格99刀怂了，也没找到破解版。
然后去找vba脚本。有个能用但只能修改页脚内容。
实在没办法只能是求助泥潭大佬了

求个能批量修改页眉页脚内容的软件，或者能看看这VBA要改什么地方才能让页眉也在范围内。

VBA

功能示例：
有很多个doc文档，页脚的电话变了，如原电话是4007339339，现在变成4007168339了，要实现批量替换，可使用此程序。

使用说明：
1、 复制下面程序代码到VBA里后，点“工具”－“宏”－“宏”－“change”－“运行”
2、 输入目录(不要输入根目录，要不速度会很慢)
3、 输入要查找的内容
4、 输入的替换成你要的内容
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'下面是程序代码，复制到Word的VBA里


'此子程序放在Word对象里Option ExplicitSub change()
   Dim s As StringDim wb As ObjectDim i As LongDim load As StringDim find As StringDim change As String

load = InputBox("输入要修改页脚的文件夹路径，自动扫描子文件夹－－－－－－－－－－－－－垃圾桶丁2009-3-8")   '要变更的目录find = InputBox("输入要查找的页脚内容")   '查找的内容change = InputBox("请问要替换成什么内容？") '替换的内容

Set wb = Application.FileSearch   With wb       .NewSearch       .LookIn = load       .SearchSubFolders = True       .FileName = "*.doc"       .FileType = msoFileTypeExcelWorkbooks      If .Execute() > 0 Then         For i = 1 To .FoundFiles.Count                On Error Resume Next         s = .FoundFiles(i)
         Call Macro1(s, find, change)            Next i       End If    End WithEnd Sub

'此子程序放在模块里
Option ExplicitSub Macro1(s As String, find As String,change As String)

   Documents.Open FileName:=s, ConfirmConversions:=False, _       ReadOnly:=False, AddToRecentFiles:=False,PasswordDocument:="", _       PasswordTemplate:="", Revert:=False,WritePasswordDocument:="", _       WritePasswordTemplate:="", Format:=wdOpenFormatAuto,XMLTransform:=""   If ActiveWindow.View.SplitSpecial <> wdPaneNone Then       ActiveWindow.Panes(2).Close   End If   If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _       ActivePane.View.Type = wdOutlineView Then       ActiveWindow.ActivePane.View.Type = wdPrintView   End If   ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader   If Selection.HeaderFooter.IsHeader = True Then       ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter   Else       ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader   End If   Selection.find.ClearFormatting    Selection.find.Replacement.ClearFormatting   With Selection.find       .Text = find '查找的内容       .Replacement.Text = change '替换的内容       .Forward = True       .Wrap = wdFindContinue       .Format = False       .MatchCase = False       .MatchWholeWord = False       .MatchByte = True       .MatchWildcards = False       .MatchSoundsLike = False       .MatchAllWordForms = False   End With   Selection.find.Execute Replace:=wdReplaceAll   ActiveWindow.Close (wdSaveChanges)End Sub

Geminize 发表于 2017-12-29 14:45

鸟瞰的坠途 发表于 2017-12-29 14:49

Geminize 发表于 2017-12-29 14:45
docx的话，试试扩展名改zip，用WinRAR全部解压到单独的目录，用UltraEdit按Ctrl+Shift+P指定上一级目录，文 ...

感谢，悲剧的是...都是doc的文档

页眉页脚很多小工具不支持或者是简单粗暴的新建，不能只修改部分内容相当蛋疼。

Geminize 发表于 2017-12-29 14:54

绕指流光 发表于 2017-12-29 16:05

这个不难啊……楼主你贴的VBA是能够扫描页眉页脚的，VBA里已经做了判断了
   If Selection.HeaderFooter.IsHeader = True Then
       ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
   Else
       ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
   End If
上面这段就是，你说页眉改不了，那还是提供一个样本doc文件给我分析一下原因

绕指流光 发表于 2017-12-29 16:34

好了不用了，我知道问题在哪了，写这代码的人比我这半吊子还水，照抄的word F1。懒得从头写了，给你个更丑陋但应该能用的
'此子程序放在模块里

Option Explicit
Sub Macro1(s As String, find As String,change As String)


   Documents.Open FileName:=s, ConfirmConversions:=False, _
       ReadOnly:=False, AddToRecentFiles:=False,PasswordDocument:="", _
       PasswordTemplate:="", Revert:=False,WritePasswordDocument:="", _
       WritePasswordTemplate:="", Format:=wdOpenFormatAuto,XMLTransform:=""
   If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
       ActiveWindow.Panes(2).Close
   End If
   If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
       ActivePane.View.Type = wdOutlineView Then
       ActiveWindow.ActivePane.View.Type = wdPrintView
   End If
   ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
   Selection.find.ClearFormatting
    Selection.find.Replacement.ClearFormatting
   With Selection.find
       .Text = find '查找的内容
       .Replacement.Text = change '替换的内容
       .Forward = True
       .Wrap = wdFindContinue
       .Format = False
       .MatchCase = False
       .MatchWholeWord = False
       .MatchByte = True
       .MatchWildcards = False
       .MatchSoundsLike = False
       .MatchAllWordForms = False
   End With
   Selection.find.Execute Replace:=wdReplaceAll

ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
   Selection.find.ClearFormatting
    Selection.find.Replacement.ClearFormatting
   With Selection.find
       .Text = find '查找的内容
       .Replacement.Text = change '替换的内容
       .Forward = True
       .Wrap = wdFindContinue
       .Format = False
       .MatchCase = False
       .MatchWholeWord = False
       .MatchByte = True
       .MatchWildcards = False
       .MatchSoundsLike = False
       .MatchAllWordForms = False
   End With
   Selection.find.Execute Replace:=wdReplaceAll


   ActiveWindow.Close (wdSaveChanges)
End Sub

BRRM 发表于 2017-12-30 04:10

知道会编程的好了吧，能解析doc xlsl的库有的是，随便写几行就能完成你的需求了。

上面那个vba的代码看的都要吐血...

天气姐姐 发表于 2017-12-30 08:58

虽然我不懂，但是，我觉得
python应该很擅长处理这种问题
吧

—— 来自 OnePlus ONEPLUS A5000, Android 7.1.1上的 S1Next-鹅版 v1.3.2.1-fix-play

鸟瞰的坠途 发表于 2017-12-30 20:30

绕指流光 发表于 2017-12-29 16:34
好了不用了，我知道问题在哪了，写这代码的人比我这半吊子还水，照抄的word F1。懒得从头写了，给你个更丑 ...

谢大大，能用就行。

鸟瞰的坠途 发表于 2017-12-30 20:31

BRRM 发表于 2017-12-30 04:10
知道会编程的好了吧，能解析doc xlsl的库有的是，随便写几行就能完成你的需求了。

上面那个vba的代码看的 ...

确实=。= ，超能力是第一生产力

schneehertz 发表于 2017-12-30 22:32

BRRM 发表于 2017-12-30 04:10
知道会编程的好了吧，能解析doc xlsl的库有的是，随便写几行就能完成你的需求了。

上面那个vba的代码看的 ...

讲道理,上面的VBA代码要是会写的人来写,也是几行而已.还不用搭运行环境

BRRM 发表于 2017-12-31 00:41

schneehertz 发表于 2017-12-30 22:32
讲道理,上面的VBA代码要是会写的人来写,也是几行而已.还不用搭运行环境
你说的会写的人不就是我说“会编程”的人了吗...

查看完整版本: 批量修改word，excel页眉页脚内容求助