用VBA实现批量修改多个文档内容VIP专享

用 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 & ...