VBA复制Word中Shape对象时如何保留内部表格原有格式设置

• Word文档的Shape（形状）对象内放置了表格，要求复制形状时完整保留内部表格的全部格式设置。
• 初始方案调用Duplicate方法复制形状，代码如下：

Dim oApp As Object
Dim oDoc As Object
Dim oTable2  As Object
Set oApp = CreateObject("Word.Application")
oApp.Visible = True
Set oDocument = oApp.Documents.Open("E:\2022\t3.docx")
Set oTable2 = oDocument.Shapes(1).Duplicate

• 上述代码执行后，形状内表格的字体、字号自动变更，原有格式丢失，运行效果：
  

Shape.Duplicate方法存在已知限制：复制包含嵌套表格、富文本内容的形状时，不会携带内嵌内容的自定义格式，会直接套用文档默认样式，导致格式错乱。改用复制+源格式粘贴的逻辑即可完整保留所有格式，效果和Duplicate一致，代码如下：

' 后期绑定场景下先声明常量，提前引用Word对象库可省略这行
Const wdFormatOriginalFormatting As Long = 18

Dim oApp As Object
Dim oDoc As Object
Dim oNewShape As Object
Set oApp = CreateObject("Word.Application")
oApp.Visible = True
Set oDoc = oApp.Documents.Open("E:\2022\t3.docx")

' 复制原形状
oDoc.Shapes(1).Copy
' 按源格式粘贴
oDoc.Range().PasteAndFormat Type:=wdFormatOriginalFormatting
' 取新生成的形状对象
Set oNewShape = oDoc.Shapes(oDoc.Shapes.Count)

' 按需调整新形状位置，要和Duplicate默认偏移效果对齐可自行设置Top、Left值
' oNewShape.Top = oDoc.Shapes(1).Top + 20
' oNewShape.Left = oDoc.Shapes(1).Left + 20

注意事项 #

• 复制和粘贴操作之间不要执行其他选中、剪贴板操作，避免粘贴目标错误。
• 该方案对形状内嵌套的文本框、图片、表格等所有内容都能完整保留格式，不会出现样式丢失问题。
• 批量复制场景下循环执行复制、粘贴逻辑即可，稳定性比直接调用Duplicate更高。

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