用VBA將多個Excel范圍復制到Word中，如圖所示

Question

大家好，我是VBA的新手，我正努力嘗試創建一個宏。 我想將粘貼圖形復制到Excel中的Word文件的多個范圍內。

這是我想出的代碼：

Sub imagem1()
    Dim objWord, objDoc As Object
    ActiveWindow.View = xlNormalView
    Worksheets(2).Range("A1:O47").Select
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Set objWord = CreateObject("Word.Application")
    Set objDoc = objWord.Documents.Add
    objWord.Visible = True
    objWord.Selection.Paste
    objWord.Selection.TypeParagraph
    ActiveWindow.View = xlPageBreakPreview

End Sub

Sub imagem2()
    Dim objWord, objDoc As Object
    ActiveWindow.View = xlNormalView
    Worksheets(2).Range("U1:AI47").Select
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Set objWord = CreateObject("Word.Application")
    Set objDoc = objWord.Documents.Add
    objWord.Visible = True
    objWord.Selection.Paste
    objWord.Selection.TypeParagraph
    ActiveWindow.View = xlPageBreakPreview
End Sub

Sub imagem3()
    Dim objWord, objDoc As Object
    Worksheets(4).Activate
    ActiveWindow.View = xlNormalView
    Worksheets(4).Range("A1:Q47").Select
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Set objWord = CreateObject("Word.Application")
    Set objDoc = objWord.Documents.Add
    objWord.Visible = True
    objWord.Selection.Paste
    objWord.Selection.TypeParagraph
    ActiveWindow.View = xlPageBreakPreview
End Sub

我遇到的問題是它將創建三個不同的Word文件，每個文件有一個圖像。 我想知道如何編碼，以便將3張圖像粘貼到相同的word文件中。

我還想使它不會在每次使用宏時都創建一個新的Word文件，而是將3張圖像復制到光標所在的已打開的Word文件中。

非常感謝您的幫助。

Answer 1

已測試（更改了我的測試范圍）：

Sub imagem1()

    Dim objWord As Object, objDoc As Object, Rng As Object
    Dim wb As Workbook

    Set wb = ActiveWorkbook

    'see if Word is already open
    On Error Resume Next
    Set objWord = GetObject(, "Word.Application")
    On Error GoTo 0

    'not open - create a new instance and add a document
    If objWord Is Nothing Then
        Set objWord = CreateObject("Word.Application")
        objWord.Visible = True
        objWord.documents.Add
    End If

    Set objDoc = objWord.activedocument
    Set Rng = objWord.Selection

    wb.Windows(1).View = xlNormalView

    wb.Worksheets(1).Range("A1:C5").CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Rng.Paste
    Rng.typeparagraph

    wb.Worksheets(1).Range("A7:C12").CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Rng.Paste
    Rng.typeparagraph

    wb.Worksheets(1).Range("A14:C19").CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Rng.Paste
    Rng.typeparagraph

End Sub