批量替换word中指定的页面

xipick · 发表于 2011-12-14 20:41

本帖最后由 xipick 于 2011-12-14 20:45 编辑

现在我想实现这个目的，有若干个word文档，现在要把这些文档中的3到7页全部替换成另外一文档中的3-7页，在论坛里面找了两天代码，终于被我拼凑出下面的这个样子，经过在2007中运行，发现能够实现，可是在office2003及wps中怎么也运行不起来。现把代码贴出来，求版主帮忙改进一下啊。多谢了。

Sub 批量替换word中的某几页()
'以下是批量操作前的准备工作，也就是把要粘贴的东西复制到剪切板
Dialogs(wdDialogFileOpen).Show '选择用来替换的内容所在的文件
'以下是指定用来替换的内容所在的页面，然后复制
Dim P1 As String, P2 As String, PS() As String, PageHome As Integer, PageEnd As Integer, EndPage As Long
On Error Resume Next
P1 = InputBox(prompt:="请在此输入连续页的首页-尾页,以-为分隔符！如“4-4”", Title:="请输入用来替换的内容所在的页面")
If P1 = "" Then Exit Sub
PS = Split(P1, "-") '返回一个以"-"分隔的一维数组
If UBound(PS) > 1 Then Exit Sub '如果上标大于1,则退出(用户连续型输入如1-2-7")
PageHome = PS(0) '首页为数组下标
PageEnd = PS(1) '尾页为数组上标
If PageHome > PageEnd Then Exit Sub '尾页大于首页则退出
If PageHome < 1 Then Exit Sub '首页小于1则退出
With ActiveDocument
'EndPage为尾页位置,如果大于文档总页数,则为文档最后位置;反之则下一页的起始位置
EndPage = VBA.IIf(PageEnd >= .GoTo(wdGoToPage, wdGoToNext, , PageEnd).Information(wdNumberOfPagesInDocument), .Content.End, .GoTo(wdGoToPage, wdGoToNext, , PageEnd + 1).Start)
'选定指定区域
.Range(.GoTo(wdGoToPage, wdGoToNext, , PageHome).Start, EndPage).Select
End With
Selection.Copy
'以是选择用来替换的内容所在的文件，然后复制用来替换的内容
ActiveDocument.Close
P2 = InputBox(prompt:="请在此输入连续页的首页-尾页,以-为分隔符！如“4-4”", Title:="请输入所要替换的页面")
'以下是重复执行代码
Dim MyDialog As FileDialog, GetStr(1 To 1000) As String '1000是工作时最多的文档数,可以修改
On Error Resume Next
Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
With MyDialog
.Filters.Clear
.Filters.Add "所有WORD文件", "*.doc", 1
.AllowMultiSelect = True '允许多项选择
i = 1
If .Show = -1 Then
For Each stiSelectedItem In .SelectedItems
GetStr(i) = stiSelectedItem
i = i + 1
Next
i = i - 1
End If
Application.ScreenUpdating = False
For j = 1 To i Step 1
Set Doc = Documents.Open(FileName:=GetStr(j), Visible:=True)
Windows(GetStr(j)).Activate
'以下是在单个文件中运行的宏
If P2 = "" Then Exit Sub
PS = Split(P2, "-") '返回一个以"-"分隔的一维数组
If UBound(PS) > 1 Then Exit Sub '如果上标大于1,则退出(用户连续型输入如1-2-7")
PageHome = PS(0) '首页为数组下标
PageEnd = PS(1) '尾页为数组上标
If PageHome > PageEnd Then Exit Sub '尾页大于首页则退出
If PageHome < 1 Then Exit Sub '首页小于1则退出
With ActiveDocument
'EndPage为尾页位置,如果大于文档总页数,则为文档最后位置;反之则下一页的起始位置
EndPage = VBA.IIf(PageEnd >= .GoTo(wdGoToPage, wdGoToNext, , PageEnd).Information(wdNumberOfPagesInDocument), .Content.End, .GoTo(wdGoToPage, wdGoToNext, , PageEnd + 1).Start)
'选定指定区域
.Range(.GoTo(wdGoToPage, wdGoToNext, , PageHome).Start, EndPage).Select
End With
Selection.PasteAndFormat (wdPasteDefault)
'以上是在单个文件中运行的宏
Selection.Find.Execute Replace:=wdReplaceAll
Application.Run macroname:="NEWMACROS"
ActiveDocument.Save
ActiveWindow.Close
Next
Application.ScreenUpdating = True
End With
MsgBox "修改完毕!请查看！！", vbInformation
End Sub

复制代码

运行该宏后，第一步选择用来替换的页面所在的文件，第二步填写用来替换的页面的位置，第三步填写所要替换的页面的位置，第四步选择要批量替换的文件。

或者直接下载下面的附件

批量替换word指定的页面.rar (15.62 KB, 下载次数: 112)

PurpleIdea · 发表于 2011-12-14 21:01

帮顶~~~~~~~~~

tawxf · 发表于 2011-12-14 22:12

做个记号,准备收藏这个工具

乐乐腾 · 发表于 2012-1-5 15:35

这个东西非常好呀，刚好我们单位要批量更换首页，谢谢了！

tzhisun · 发表于 2012-10-17 16:00

太好了，正要批量替换首页》》》....雪中送炭啊...谢谢啦。。。

wxiaoxiao · 发表于 2012-10-18 21:04

这个确实强大呀，牛人

x332553761 · 发表于 2015-9-16 19:45

关于这个事我也是写了2个小时代码，发现这有个现成的

		自动登录	找回密码
密码			免费注册

[求助] 批量替换word中指定的页面