用VBA实现批量修改多个Word文档内容用vba实现多个word文档里的多个内容进行批量更改说明：本方法思路是借用excel的表格对多个内容进行界面管理，再用excel的vba调用word文件进行查找更改。使用方法：将以下内容（不包括本句）复制进excel的宏模块，保存，然后excel界面设置如下：多个卿R信息批量替换耳IF*科粘41tan1?■扎十输入数据，运行宏就可以了。(若需要现成的excel文件，请单独下载)注：版权所有严禁转载Sub更新录入()Dima,b,zhszhs=Sheetl.Range("c"&Rows.Count).End(xlUp).Rowp=ThisWorkbook.Path&"\"IfSheet1.Range("c5").Value=""Thenwjj="新文书"Elsewjj=Sheet1.Range("c5").ValueEndIfIfzhs<3ThenCreateObject("Wscript.shell").popup"没有数据可以录入，请输入数据后再点击生成新文档！",1,"提示！",0+32ExitSubEndIfIfSheet1.Range("F1")<>"修改本级文档”ThenOnErrorResumeNextSetofso=CreateObject("Scripting.FileSystemObject")生成'文件夹ofso.CreateFolder(p&wjj)OnErrorGoTo0'替换本级或生成新的ElseIfMsgBox("是否替换本级文件夹内文档？",vbYesNo,"提示")=vbNoThen:ExitSubElsewjj=""EndIfApplication.ScreenUpdating=FalseWithCreateObject("Word.Application").Visible=Falsef=Dir(p&"*.doc")DoWhilef<>""i=i+1.Documents.Openp&fForb=3TozhsIfSheet1.Range("C"&b)<>""Then'有数据才替换.Selection.HomeKeyUnit:=6'到文档开始地方DoWhile.Selection.Find.Execute(Sheet1.Range("B"&b))查'找s.Selection.Font.Color=wdColorAutomatic'字体颜色.Selection.Text=Sheet1.Range("C"&b)替'换.Selection.MoveRightUnit:=1,Count:=1'右移LoopEndIfNext.ActiveDocument.SaveAsp&wjj&"\"&f'另存为。。。.Documents.CloseFalsef=DirLoop.QuitEndWithApplication.ScreenUpdating=TrueIfSheet1.Range("F1")="修改本级文档"ThenMsgBox("完成共修改"&i&"个文档。联系QQ：136941975""提示")直接退'出ExitSubEndIfms=MsgBox("共修改"&i&"个文档。联系QQ：136941975"&vbCrLf&"是否保存数据？"&vbCrLf&"点击“是”保存数据；点击“否”取消保存。",vbYesNo+vbInformation,"提示")Ifms=vbNoThenActiveWorkbook.SaveActiveWorkbook.SaveAsFilename:=_p&wjj&"\"&"001信息录入.xlsm",FileFormat:=_xlOpenXMLWorkbookMacroEnabled,CreateBackup:=FalseExitSubEndIf数据保存_AActiveWorkbook.SaveActiveWorkbook.SaveAsFilename:=_p&wjj&"\"&"001信息录入.xlsm",FileFormat:=_xlOpenXMLWorkbookMacroEnabled,CreateBackup:=FalseEndSubSub数据提取_A()DimccsjAsRangeIfSheet1.Range("F2")=""ThenCreateObject("Wscript.shell").popup"请选择已存数据！",1,提示！"",0+32ExitSubEndIfzhs=Sheet1.Range("c"&Rows.Count).End(xlUp