如何通过Excel按钮复制嵌入Word文档（Object 1）的带格式文本？

问题场景 #

• Excel Dashboard中的VBA按钮需复制模板内容到工作管理系统，系统升级后支持格式化粘贴，但直接复制单元格文本会丢失加粗、项目符号等格式
• 经测试，从Word文档复制粘贴可完整保留格式，因此需实现点击按钮复制工作表中嵌入的名为Object 1的Word文档内容（公式栏显示=EMBED("Word.Document.12","")）

原代码问题分析 #

原代码存在两处关键问题：

1. 错误尝试从Word的ActiveDocument中查找嵌入对象，实际嵌入对象属于Excel工作表，而非Word文档
2. 仅提取了纯文本objDoc.Content.Text，未保留格式，无法满足需求

修正后的VBA代码 #

Private Sub CommandButton1_Click()
    Dim oleObj As OLEObject
    Dim wordDoc As Object
    Dim ws As Worksheet
    
    ' 指定嵌入Word对象所在的工作表，可根据实际修改
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 查找名为"Object 1"的嵌入OLE对象
    On Error Resume Next
    Set oleObj = ws.OLEObjects("Object 1")
    On Error GoTo 0
    
    ' 检查对象是否存在
    If oleObj Is Nothing Then
        MsgBox "未找到名为'Object 1'的嵌入Word文档。"
        Exit Sub
    End If
    
    ' 获取嵌入的Word文档对象
    Set wordDoc = oleObj.Object
    
    ' 激活Word文档并全选复制内容（保留格式）
    wordDoc.Application.Visible = False ' 避免Word窗口弹出
    wordDoc.Content.Select
    wordDoc.Application.Selection.Copy
    
    ' 清理对象
    Set wordDoc = Nothing
    Set oleObj = Nothing
    Set ws = Nothing
    
    MsgBox "带格式内容已复制到剪贴板！"
End Sub

关键说明 #

• 直接从Excel工作表的OLEObjects集合中获取目标对象，路径更准确
• 使用wordDoc.Application.Selection.Copy复制带格式的内容，而非纯文本
• 设置wordDoc.Application.Visible = False避免操作时弹出Word窗口，提升用户体验
• 增加错误检查，确保对象存在时再执行后续操作

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