拷贝多个Excel单元格区域为图片并粘贴到Word

Excel工作表Sheet1中有两个报表，相应单元格区域分别定义名称为Report1和Report2，如下图所示。

现在需要将图片拷贝图片粘贴到新建的Word文档中。

示例代码如下。

Sub Demo()
    Dim oWordApp As Object
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
    Dim rRpt1 As Range: Set rRpt1 = ws.Range("Report1")
    Dim rRpt2 As Range: Set rRpt2 = ws.Range("Report2")
    On Error Resume Next
    Set oWordApp = GetObject(Class:="Word.Application")
    If oWordApp Is Nothing Then
        Set oWordApp = CreateObject(Class:="Word.Application")
    End If
    On Error GoTo 0
    oWordApp.Visible = True
    Dim oDoc As Object: Set oDoc = oWordApp.Documents.Add
    rRpt1.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    oDoc.Content.Paste
    oDoc.Content.InsertParagraphAfter
    rRpt2.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    oDoc.Content.InsertParagraphAfter
    oDoc.Content.Paste
    ' oDoc.SaveAs2 "C:\temp\report.docx"
    ' oDoc.Close
    ' oWordApp.Quit
End Sub

【代码解析】
第3行代码获取工作表对象。
第4~5行代码获取单元格区域Range对象。
第6~11行代码获取Word应用程序对象，如果没有打开的Word应用程序，那么将新建一个。
第12行代码显示Word应用程序（新建的Word应用程序处于隐藏状态）。
第13行代码新建Word文档。
第14行代码将报表1拷贝为图片。
第15行代码在Word文档中粘贴图片。
第16行代码插入段落分隔符。
第17~19行代码使用类似的方法处理报表2。
第20行代码保存新建的Word文档。
第21行代码关闭Word文档。
第22行代码关闭Word应用程序。

运行代码，新建Word文档如下所示，只有报告2，并没有报告1。

使用单步调试运行代码，发现第15行代码执行之后，Word文档中插入了报表1，但是第19行代码（oDoc.Content.Paste）执行时将文档全部内容替换为报表2，因此报表1从此消失。

找到了问题的根源，那么可以使用如下两个方案解决问题。

    ' 方法1
    With oDoc.Content
        rRpt1.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        .Paste
        .InsertParagraphAfter
        rRpt2.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        .Characters.Last.Paste
    End With

【代码解析】
oDoc.Content.Characters.Last获取文档中的最后一个字符，报表2图片将粘贴在此位置，避免覆盖已有的文档内容。

    ' 方法2
    With oDoc.Content
        rRpt1.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        .Paste
        .InsertParagraphAfter
        oWordApp.Selection.endKey Unit:=6
        rRpt2.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        oWordApp.Selection.Paste
    End With

【代码解析】
第5行代码将Word编辑游标定位到文档末尾，第7行代码使用Selection.Paste粘贴报表2。

运行修改的代码，结果如下图所示。