如何用VBA将Excel图表复制到Word指定段落？

核心问题是你没有将粘贴操作定位到指定段落的Range对象上，只要先获取目标段落的Range，再将图表粘贴到这个Range中，就能实现精准插入。

修改后的完整代码示例 #

Sub InsertChartsToTargetParagraphs()
    Dim wb1 As Workbook
    Dim ws As Worksheet
    Dim chObject As ChartObject
    Dim wordApp As Object
    Dim wordDoc As Object
    Dim targetRange As Object
    ' 定义要插入的段落序号，按图表顺序对应
    Dim targetParagraphs As Variant
    Dim i As Integer
    
    ' 配置：替换为你的目标段落序号，比如第一个图表放第5段，第二个放第10段
    targetParagraphs = Array(5, 10)
    
    ' 关联Excel工作簿和工作表
    Set wb1 = ThisWorkbook ' 若文件未打开，改用Workbooks.Open("你的Excel文件路径.xlsx")
    Set ws = wb1.Worksheets("Sheet1")
    
    ' 初始化Word应用并打开目标文档
    Set wordApp = CreateObject("Word.Application")
    wordApp.Visible = True ' 调试时保持可见，发布可改为False
    Set wordDoc = wordApp.Documents.Open("你的Word文档路径.docx")
    
    ' 循环插入每个图表到对应段落
    For i = LBound(targetParagraphs) To UBound(targetParagraphs)
        ' 获取指定段落的Range对象
        Set targetRange = wordDoc.Paragraphs(targetParagraphs(i)).Range
        
        ' 可选：将光标移到段落末尾（图表插在段落内容之后）
        ' 若要插在段落开头，将Direction改为1（wdCollapseStart）
        targetRange.Collapse Direction:=0 ' wdCollapseEnd，值为0
        
        ' 复制Excel图表
        Set chObject = ws.ChartObjects(i + 1) ' 按顺序取Sheet1中的图表
        chObject.CopyPicture xlScreen, xlPicture
        
        ' 粘贴到目标位置（保留原错误重试逻辑）
        On Error Resume Next
        Do
            Err.Clear
            targetRange.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdInLine, DisplayAsIcon:=False
            DoEvents
            If Err.Number <> 0 Then Application.Wait DateAdd("s", 1, Now)
        Loop While Err.Number <> 0
        On Error GoTo 0
        
        ' 可选：在图表后添加换行，避免和后续内容拥挤
        targetRange.InsertAfter vbCrLf
    Next i
    
    ' 可选：保存文档、关闭应用
    wordDoc.Save
    ' wordDoc.Close
    ' wordApp.Quit
    
    ' 释放对象
    Set targetRange = Nothing
    Set wordDoc = Nothing
    Set wordApp = Nothing
    Set chObject = Nothing
    Set ws = Nothing
    Set wb1 = Nothing
End Sub

关键说明 #

1. 精准定位段落：通过wordDoc.Paragraphs(段落序号).Range直接获取目标段落的范围，这是实现指定位置插入的核心。Word的段落序号从1开始计数，确保你的段落序号对应正确。
2. 调整插入位置：用targetRange.Collapse可以控制图表插在段落的开头还是末尾：
   • Direction:=0（wdCollapseEnd）：插在段落内容之后
   • Direction:=1（wdCollapseStart）：插在段落内容之前
3. 批量处理：用数组targetParagraphs存储所有目标段落序号，循环即可完成多个图表的对应插入，无需重复写代码。
4. 绑定方式：示例用的是后期绑定（无需引用Word库），如果要更智能的代码提示，可在VBA编辑器的「工具」→「引用」中勾选「Microsoft Word xx.x Object Library」，然后将Object类型改为Word.Application、Word.Document等。

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