求修改代码

同心/ty

求大神帮我修改一下代码：要求表格中b2单元格图片写入word指定方框中。此代码借用论坛老师的代码，但在我的例子里没有达到我的要求（插入位置不是我要的）。求大神修改。谢谢！

Sub 生成()
Dim appWD, doc As Object

Set appWD = CreateObject("Word.Application")
appWD.Visible = True
Set appWD = GetObject(, "Word.Application")
Set doc = GetObject(ThisWorkbook.Path & "\家庭承包合同.doc")
appWD.Visible = True

Application.CutCopyMode = False
ThisWorkbook.Activate
Range("B2").Select
Selection.Copy
appWD.Visible = True

appWD.Selection.Paste
End Sub

同心/ty

求大师出手帮我。

同心/ty

求顶，别沉下去。

excel玉米

同心/ty

excel玉米 发表于 2023-3-17 20:39

老师，按word模板修改后另存副本如何改代码？（模板不改动）

excel玉米

Wordd close true 这句改如下
wordd.Documents(1).SaveAs Filename:="f:\你要保存的文件名称.docx"

同心/ty

excel玉米 发表于 2023-3-18 13:42
Wordd close true 这句改如下
wordd.Documents(1).SaveAs Filename:="f:\你要保存的文件名称.docx"

老师，前面图片能顺利插入。但另存文件没有成功，不知为何。

excel玉米

wordd.SaveAs Filename:="f:\你要保存的文件名称.docx"
改成这样试下？

同心/ty

excel玉米 发表于 2023-3-17 20:39

老师，代码多次测试，出现问题是，我把excel单元格图片替换掉（因为此图片是变化的），再运行宏，word一直记录的是过去那张图片，没有更新，求完善代码。

同心/ty

excel玉米 发表于 2023-3-17 20:39

Sub 生成()
Dim appWD, doc As Object
Set appWD = CreateObject("Word.Application")
appWD.Visible = True
Set appWD = GetObject(, "Word.Application")
Set doc = GetObject(ThisWorkbook.Path & "\家庭承包合同.doc")
appWD.Visible = True
Application.CutCopyMode = False
ThisWorkbook.Activate
Range("H8").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
appWD.Visible = True
With appWD.Selection.Find
.Text = "图片位置"  '查找word有“图片位置”字符定位点插入图片
End With
appWD.Selection.Find.Execute
appWD.Selection.Paste
End Sub                                     ‘这组代码也可实现图片插入，将修改内容另存副本，模板不动，需要添加什么代码？老师请指教。