VBA 将图表粘贴到 Word 后如何设置当前图表

在将图表粘贴到 Word 文档的末尾后，如果你希望将新生成的图表设置为当前图表，请使用以下修订后的代码：

Sub SaveChartsAsBMPAndInsertToWord()
    ' 打开 Excel 文件
    Dim wbExcel As Workbook
    Set wbExcel = Workbooks.Open("C:\path\to\your\excel\file.xlsx")
    
    ' 打开 Word 文档
    Dim wordApp As Object
    Set wordApp = CreateObject("Word.Application")
    wordApp.Visible = True
    Dim wordDoc As Object
    Set wordDoc = wordApp.Documents.Open("C:\path\to\your\document.docx")
    
    ' 循环处理每个图表
    Dim ws As Worksheet
    Dim chartObj As ChartObject
    Dim picPath As String
    Dim i As Integer
    
    Set ws = wbExcel.Worksheets("Sheet1") ' 替换为你实际使用的工作表
    i = 1 ' 图表索引从1开始
    
    Do Until i > ws.ChartObjects.Count
        ' 选择工作表中的图表
        Set chartObj = ws.ChartObjects(i)
        
        ' 将图表保存为 BMP 图片文件
        picPath = "C:\path\to\your\image" & i & ".bmp" ' 使用不同的文件名
        chartObj.Chart.CopyPicture
        
        With CreateObject("Shell.Application")
            .Namespace(picPath).InvokeAsFile = True
        End With
        
        ' 插入 BMP 图片到 Word 文档的末尾
        wordDoc.Content.InsertAfter vbCrLf & vbCrLf
        wordDoc.Content.InsertParagraphAfter
        wordDoc.Range(wordDoc.Content.End - 1).Paste
        
        ' 设置新生成的图表为当前图表
        wordDoc.Range(wordDoc.Content.End - 1).InlineShapes(1).OLEFormat.DoVerb
        wordApp.Selection.TypeParagraph
        wordApp.Selection.TypeParagraph
        
        i = i + 1
    Loop
    
    ' 关闭 Word 文档
    wordDoc.Save
    wordDoc.Close
    wordApp.Quit
    
    ' 关闭 Excel 文件
    wbExcel.Close False
End Sub

在这个修订后的代码中，我添加了以下部分来设置新生成的图表为当前图表：

' 设置新生成的图表为当前图表
wordDoc.Range(wordDoc.Content.End - 1).InlineShapes(1).OLEFormat.DoVerb
wordApp.Selection.TypeParagraph
wordApp.Selection.TypeParagraph

这个代码片段会在每个图表粘贴完成后，使用 DoVerb 方法激活新插入的图表对象，并在两个回车键之后插入两个新的段落，以清除选择范围。

请确保将路径和工作表名称替换为你实际使用的值。

希望这个修改可以满足你的需求！如果你还有其他问题，请随时提问。