Excel工作表Sheet1中有兩個報表，相應單元格區域分別定義名稱為Report1和Report2，如下圖所示。

現在需要將圖片拷貝圖片粘貼到新建的Word文檔中。

示例代碼如下。

Sub Demo()Dim oWordApp As ObjectDim 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 NextSet oWordApp = GetObject(Class:="Word.Application")If oWordApp Is Nothing ThenSet oWordApp = CreateObject(Class:="Word.Application")End IfOn Error GoTo 0oWordApp.Visible = TrueDim oDoc As Object: Set oDoc = oWordApp.Documents.AddrRpt1.CopyPicture Appearance:=xlScreen, Format:=xlPictureoDoc.Content.PasteoDoc.Content.InsertParagraphAfterrRpt2.CopyPicture Appearance:=xlScreen, Format:=xlPictureoDoc.Content.InsertParagraphAfteroDoc.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從此消失。

找到了問題的根源，那么可以使用如下兩個方案解決問題。

    ' 方法1With oDoc.ContentrRpt1.CopyPicture Appearance:=xlScreen, Format:=xlPicture.Paste.InsertParagraphAfterrRpt2.CopyPicture Appearance:=xlScreen, Format:=xlPicture.Characters.Last.PasteEnd With

【代碼解析】
oDoc.Content.Characters.Last獲取文檔中的最后一個字符，報表2圖片將粘貼在此位置，避免覆蓋已有的文檔內容。

    ' 方法2With oDoc.ContentrRpt1.CopyPicture Appearance:=xlScreen, Format:=xlPicture.Paste.InsertParagraphAfteroWordApp.Selection.endKey Unit:=6rRpt2.CopyPicture Appearance:=xlScreen, Format:=xlPictureoWordApp.Selection.PasteEnd With

【代碼解析】
第5行代碼將Word編輯游標定位到文檔末尾，第7行代碼使用Selection.Paste粘貼報表2。

運行修改的代碼，結果如下圖所示。