(完整版)用VBA实现批量修改多个Word文档内容.doc

用vba实现多个word文档里的多个内容进行批量更改 说明：本方法思路是借用excel的表格对多个内容进行界面管理，再用excel的vba调用word文件进行查找更改。 使用方法： 将以下内容（不包括本句）复制进excel的宏模块，保存，然后excel界面设置如下： 输入数据，运行宏就可以了。（若需要现成的excel文件，请单独下载） 注：版权所有严禁转载 Sub 更新录入() Dim a, b, zhs zhs = Sheet1.Range(c Rows.Count).End(xlUp).Row p = ThisWorkbook.Path If Sheet1.Range(c5).Value = Then wjj = 新文书 Else wjj = Sheet1.Range(c5).Value End If If zhs 3 Then CreateObject(Wscript.shell).popup 没有数据可以录入,请输入数据后再点击生成新文档！, 1, 提示！, 0 + 32 Exit Sub End If If Sheet1.Range(F1) 修改本级文档 Then On Error Resume Next Set ofso = CreateObject(Scripting.FileSystemObject) 生成文件夹 ofso.CreateFolder (p wjj) On Error GoTo 0 替换本级或生成新的 ElseIf MsgBox(是否替换本级文件夹内文档？, vbYesNo, 提示) = vbNo Then: Exit Sub Else wjj = End If Application.ScreenUpdating = False With CreateObject(Word.Application) .Visible = False f = Dir(p *.doc) Do While f i = i + 1 .Documents.Open p f For b = 3 To zhs If Sheet1.Range(C b) Then 有数据才替换 .Selection.HomeKey Unit:=6 到文档开始地方 Do While .Selection.Find.Execute(Sheet1.Range(B b)) 查找s .Selection.Font.Color = wdColorAutomatic 字体颜色 .Selection.Text = Sheet1.Range(C b) 替换 .Selection.MoveRight Unit:=1, Count:=1 右移 Loop End If Next .ActiveDocument.SaveAs p wjj \ f 另存为。。。 .Documents.Close False f = Dir Loop .Quit End With Application.ScreenUpdating = True If Sheet1.Range(F1) = 修改本级文档 Then MsgBox (完成!!!共修改 i 个文档。联系QQ：136941975提示) 直接退出 Exit Sub End If ms = MsgBox(共修改 i 个文档。联系QQ：136941975 vbCrLf 是否保存数据？ vbCrLf 点击“是”保存数据；点击“否”取消保存。, vbYesNo + vbInformation, 提示) If ms = vbNo Then ActiveWorkbook.Save ActiveWorkbook.SaveAs Filename:= _ p