一种向Word文档批量插入对应图片的方法

我虽然能写几行VBA代码，但是整体上还是一个小白。我发的一些办公小技巧，之所以分享是因为比较实用，既然实用就不追求完美。分享的过程其实是不断自学的过程，如果能给别人带来帮助更好。我也尽量选择网络上不是太容易查到的方法。

向Word文档批量插入图片的方法有好多种， Word邮件合并是比较常见的方法。不过这并不是本文介绍的方法。介绍邮件合并的网络资源很多，大家可以自行检索。

假设有一组Word格式文本，需要填写不同的内容，包括插入不同的图片，批量生成新的文档，例如与签订合同、制作档案、填写审批表等等， Word邮件合并功能是一个非常惊艳的工具。

但是利用邮件合并功能插入图片。不仅程序比较复杂，而且能不能够达到预期的效果，仿佛要看Word软件的心情，有时候很顺利，有时候它怎么都不听话，要么不能成功插入图片，要么插入图片的格式不理想。

我搜索了很多解决方案，但是都不能根本解决问题，后来干脆另辟蹊径，就是今天介绍的VBA方法。我们示例的工作场景是为东汉集团每位优秀员工小档案贴上照片，如下图所示。

第1步，准备工作。把需要贴照片的东汉集团优秀员工小档案（ Word文档），全部放在同一个文件夹里（文件夹A），把需要用到的照片也全部放在同一个文件夹里（文件夹B）， Word文档和照片都用东汉集团优秀员工的姓名命名。

文件夹A和文件夹B既可以是同一个文件夹，也可以是在电脑不同位置的不同文件夹。 Word文档和照片只要是相同的文件名就行，不一定要用姓名命名。

第2步，在文件夹A新建一个空白Word文档并打开。此处注意，该新建文档必须与等待插入图片的Word文档在同一个文件夹（否则其所在文件夹如果碰巧文件名与图片文件名相同，把不需要插入图片的Word文档批量修改了，改回去是极其麻烦的）。

第3步，复制粘贴小代码。按“Alt+F11”（有的键盘可能还要同时按下“Fn”键），打开VBA编辑器，双击左侧1、2、3、4任意一处。

将小代码粘贴在图中右侧位置。

第5步，运行宏、完成任务。按“F5”（有的键盘可能要同时按“Fn”键，或者点击功能区的“运行”——“运行子过程/用户窗体”，或者点击图中绿色小三角形。

宏运行后，根据提示，选中照片所在的文件夹，点击“确定”。

如果指定插入图片的位置不存在（例如表格只有三行，你指定它在第4行插入图片），宏会在提示错误后自动退出运行。

批量插入图片完成后，宏会在刚才打开的新建文档中自动提示为多少份Word文档插入了图片，如果没有对应的图片（例如本例没有黄忠的照片），宏会提示成功为多少份 Word文档插入了图片，哪些文档没有找到对应的图片未能完成插入。

参照本公号往期文章“一分钟合并当前文件夹下所有word文档”介绍的方法，在模板文档中植入宏并创建按钮，也可以一键进入上述流程，使用会更加方便。用户可以根据这个宏的使用频率自行决定是否将该宏保存到模板文档并创建按钮。

浏览“一分钟合并当前文件夹下所有word文档”等往期文章，请回到本文顶部点击话题“办公小知识”。

特别提示：文件夹内如有保护、隐藏文件将出错。

代码中用绿色字体标出的地方，是需要根据实际情况灵活修改的。在本例中，是在表1的第1行、第7个单元格插入图片，所以相应的代码是(1)、Cell(1,7)。而在设置图片格式时，我们插入的图片在Word文档中是第1个图片，所以代码是(1)。调整图片的、值，可使其显示为我们需要的大小。

文章预告：一种将Word文档批量转换为PDF的方法

附件：vba代码如下

'注意事项，图片文件要为jpg格式，且与Word文档名称相同。

Sub Word表格插入图片()

Dim $, $, $, WdN$, $

Dim Wd As

Dim Num1&, Num2&

Dim BOX$

Dim $

Dim As

On Next

= .Path

= Dir( & "\" & "*.doc")

Num1 = 0

Num2 = 0

"请选择图片所在的文件夹。"

With .()

. = "文件夹选择"

If .Show Then

= .(1)

End If

End With

Do ""

If .Name Then

Err.

Set Wd = .Open( & "\" & )

= .Name

= & "\" & (.Name, ".")(0) & ".jpg"

With .(1).Cell(1, 7). '在指定表格的指定单元格中插入图片

If Err. > 0 Then

& "指定的插入位置不存在，请检查。"

Err.

Exit Sub

End If

.

.Text = ""

.. :=, :=, :=True

.. =

End With

With .(1) '设置图片尺寸

. = 130

. = 102

... = er

End With

If Err. > 0 Then

Num1 = Num1 + 1

WdN = WdN & Chr(13) & Wd.Name

Else

Num2 = Num2 + 1

End If

Err.

Wd. True

End If

= Dir

Loop

..

.(1)..

If Num1 = 0 Then

. Text:="您好，图片插入已完成" & Chr(13) & Chr(13) & "共为" & Num2 & "个文件插入图片。"

Else

. Text:="您好，图片插入已完成" & Chr(13) & Chr(13) & "共为" & Num2 & "个文件插入图片。" & Chr(13) & "但如下" & Num1 & "个文件对应图片未找到：" & Chr(13) & WdN

End If

With .

. = 0

. = (0)

. = er

. =

. = 29.45

End With

With ..Font '设置文档的字符格式

.Name = " 方正仿宋_GBK"

.Size = 16

. = ""

. = ""

End With

With .(1).

.Font.Size = 22

.Font.Name = " 方正小标宋_GBK"

End With

End Sub