用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