请问如果在多个word中根据word姓名导入对应照片

succleaf

有几千个word吧，独立的，每个word有对应的一张照片，请问如何根据word表格里的姓名把图片导入到指定的“照片（一寸）”中去？

多个word分别根据文档内容里的姓名导入对应照片.zip (215.41 KB, 下载次数: 32)

2020-11-23 23:23 上传

点击文件名下载附件

约定的童话

详见教程...

succleaf

约定的童话 发表于 2020-11-24 08:46
详见教程...

大佬强大。
再请问一下如果要顺便把word文件名改成姓名要怎么做？

约定的童话

succleaf 发表于 2020-11-24 08:57
大佬强大。
再请问一下如果要顺便把word文件名改成姓名要怎么做？

遍历打开文件，取出姓名，另存一下即可，再删除原始文档

3190496160

先留个足印吧，下午看看，是个有趣的问题，有挑战性

succleaf

约定的童话 发表于 2020-11-24 08:46
详见教程...

请问运行到.tables(1).cell(1, 5).Range.InlineShapes.AddPicture Filename:=p出错是怎么回事？
运行错误5152，应用程序定义或对象定义错误

------------------------------------------------
Sub 插入()
    Application.ScreenUpdating = False
    Dim f, p, s
    Set word = VBA.CreateObject("word.application")
    word.Visible = True
    f = Dir(ThisWorkbook.Path & "\*.docx")
    Do While f <> ""
       With word.documents.Open(ThisWorkbook.Path & "\" & f)
       s = Replace(Replace(.tables(1).cell(1, 2).Range, "□", ""), Chr(13), "")
       p = ThisWorkbook.Path & "\照片\" & s & ".png"
       .tables(1).cell(1, 5).Range = ""
       .tables(1).cell(1, 5).Range.InlineShapes.AddPicture Filename:=p, linktofile:=False, savewithdocument:=True
       .Close True
       End With
       f = Dir
       Loop
       word.Quit
       MsgBox "ok"
End Sub

约定的童话

succleaf 发表于 2020-11-24 17:11
请问运行到.tables(1).cell(1, 5).Range.InlineShapes.AddPicture Filename:=p出错是怎么回事？
运行错 ...

参考2楼附件...

wdpfox

感谢楼主分享，支持一下！

We meet by chance like patches of drifting duckweed,  
May everything be fine with you everyday !
  （你我萍水相逢，愿君一切安好！）