合并100个Word文档,居然只要10秒!图片格式全保留,告别手动复制!
月底要合并几十份周报、合同、方案……一个个打开、复制、粘贴,结果图片全丢了,格式乱成粥,又得加班到深夜?😭
今天分享一段VBA代码,一键合并文件夹里所有Word文档(.doc/.docx),图片、表格、排版全部原样保留,比手工快100倍!
👇代码拿走就能用(不用懂编程,复制粘贴就行):
Sub MergeDocumentsInFolder() Dim fd As FileDialog Dim strFolderPath As String Dim strFileName As String Dim destDoc As Document Dim destRange As Range Dim i As Integer Set fd = Application.FileDialog(msoFileDialogFolderPicker) If fd.Show = -1 Then strFolderPath = fd.SelectedItems(1) Else MsgBox "没有选择目录。" Exit Sub End If strFolderPath = strFolderPath & "\" Set destDoc = Documents.Add(Visible:=False) Set destRange = destDoc.Range(0, 0) ' 遍历文件夹中的Word文档(.doc, .docx, .docm等) strFileName = Dir(strFolderPath & "*.doc*") i = 0 Do While strFileName <> "" If Left(strFileName, 2) <> "~$" Then destRange.InsertFile FileName:=strFolderPath & strFileName, _ Range:="",ConfirmConversions:=False Set destRange = destDoc.Range(destDoc.Range.End - 1, destDoc.Range.End - 1) destRange.InsertBreak Type:=wdPageBreak Set destRange = destDoc.Range(destDoc.Range.End - 1, destDoc.Range.End - 1) i = i + 1 End If strFileName = Dir Loop ' 如果有文档被合并,保存结果 If i > 0 Then destDoc.SaveAs2 FileName:=strFolderPath & "合并后的文档.docx", _ FileFormat:=wdFormatDocumentDefault destDoc.Close MsgBox "已合并 " & i & " 个文档,保存到:" & vbCrLf & strFolderPath & "合并后的文档.docx" Else destDoc.Close SaveChanges:=False MsgBox "文件夹中没有找到Word文档。" End IfEnd Sub
怎么用? 打开Word → 按 Alt+F11 进入VBA编辑器 → 插入模块 → 粘贴代码 → 按 F5 运行 → 选择文件夹 → 等待几秒 → 搞定!
合并后的文档自动保存在原文件夹,文件名“合并后的文档.docx”,所有源文档格式、图片都完美保留。
⭐ 星标提醒由于公众号改版,想第一时间收到Excel每日一学的干货,记得关注我们并设为星标⭐,不再错过任何实用技巧!
👍 互动 觉得有用的话,点个“在看”
+点赞
+“转发“
,互动越多,免费干货更新越快!
同时欢迎转发
、点赞
或点个“在看”
。
📢 广告支持不用花一分钱,点击文末的广告,就是对我们持续创作免费干货的最大支持,感谢每一位朋友的认可!
💬 互动问题 你平时做表最头疼的重复操作是什么?还想解锁哪些实用的Excel/VBA技能?评论区留言告诉我们,下一篇可能就解决! 📂 示例文件 留言“有用”并后在台发送“260222”即可领取,直接拿去用!,即可获取配套示例文件 (含代码和测试文档)
夜雨聆风
