将VBA复制到Word的Excel范围如图所示

大家好我对VBA很新，我正在努力创build一个macros。 我想复制作为数字的粘贴到Word文件倍数范围从Excel。

这是我想到的代码：

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 

我遇到的问题是，它将创build三个不同的单词文件与每个图像。 我想知道如何编码，所以它会粘贴到同一个文件的3个图像。

我还想使它不会创build一个新的单词文件，每次我使用macros，而是将3个图像复制到光标所在的已经打开的单词文件中。

非常感谢您的帮助。

Answer 1

testing（改变我的testing范围）：

 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