求助：如何通过VBA将Word .docx模板中带书签的形状复制到新文档？

问题背景 #

我有一个包含多个带书签名称形状的Word .docx模板，需通过VBA代码传入书签名称，将对应形状复制粘贴到目标新Word文档。此前在.doc格式旧模板中使用的VBA代码有效，但切换到.docx模板后，尝试的两行代码均报错。

报错详情 #

• 执行代码 SrcDoc.Shapes.Range(Array(bmName)).Select 时，报错：The item with specified name wasn't found
• 执行代码 SrcDoc.Bookmarks("bmName").Select 时，报错：The requested member of the collection does not exist.

原.doc模板有效代码 #

If SrcDoc.Bookmarks.Exists(bmName) Then
  SrcDoc.Shapes(bmName).Select
  WrdApp.Selection.Copy
  DestDoc.Activate
  DestDoc.Bookmarks("\EndOfDoc").Select
  WrdApp.Selection.PasteAndFormat wdPasteDefault

解决方案 #

问题根源 #

.doc与.docx的Word对象模型存在细微差异：旧代码依赖Select方法操作对象，而.docx中形状与书签的关联逻辑更严格，直接通过Shapes(bmName)调用可能因名称不匹配或上下文失效导致报错。

优化后代码（适配.docx） #

Dim srcShape As Shape
Dim destRange As Range

' 验证目标书签存在性
If SrcDoc.Bookmarks.Exists(bmName) Then
    ' 通过书签范围获取关联形状（避免Select操作）
    Set srcShape = SrcDoc.Bookmarks(bmName).Range.ShapeRange(1)
    ' 复制形状对象
    srcShape.Copy
    ' 获取目标文档末尾的范围对象
    Set destRange = DestDoc.Bookmarks("\EndOfDoc").Range
    ' 粘贴到目标位置
    destRange.PasteAndFormat wdPasteDefault
End If

额外排查要点 #

• 确认.docx模板中形状的Name属性与书签名称完全一致（Word .docx对名称大小写敏感，需严格匹配）；
• 若书签绑定的是多个形状，可调整ShapeRange(1)为对应索引，或遍历ShapeRange集合处理。

内容的提问来源于stack exchange，提问作者sha