excelvbamacosms-word

VBA: Pasting Multiple Ranges into Word Doc in Order


Sub Test_Pictures()

    Dim rng1 As Range, rng2 As Range
    Dim wordApp As Object
    Dim wordDoc As Object
    Dim ws As Worksheet
    
    Set ws = ThisWorkbook.Sheets("01")
    Set rng1 = ws.Range("Report01_1")
    Set rng2 = ws.Range("Report01_2")
    
    On Error Resume Next
    Set wordApp = GetObject(Class:="Word.Application")
    If wordApp Is Nothing Then
        Set wordApp = CreateObject(Class:="Word.Application")
    End If
    On Error GoTo 0
    
    wordApp.Visible = True
    Set wordDoc = wordApp.Documents.Add
    
    With wordDoc.Range
    
        rng1.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        wordDoc.Content.Paste
        wordDoc.Content.InsertParagraphAfter
    
        rng2.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        wordDoc.Content.InsertAfter vbCr
        wordDoc.Content.Paste
    End With
    
End Sub

I am trying to paste multiple "pictures" of named ranges from my workbook ontop of one another into a word doc. However, it seems that the "rng2" image overwrites the "rng1" image every time I run the macro.

In Word, only the "rng2" image shows, and if I Ctrl+Z, the "rng1" image shows which leads me to believe this image is being overwritten. Any ideas on a fix for this?


Solution

  • The 2nd wordDoc.Content.Paste replaces the content of Doc (include the first picture) with a new picture (the 2nd).

    Try

        With wordDoc.Content 
            rng1.CopyPicture Appearance:=xlScreen, Format:=xlPicture
            .Paste
            .InsertParagraphAfter
            rng2.CopyPicture Appearance:=xlScreen, Format:=xlPicture
            .Characters.Last.Paste
        End With
    

    OR

        With wordDoc.Content 
            rng1.CopyPicture Appearance:=xlScreen, Format:=xlPicture
            .Paste
            .InsertParagraphAfter
            wordApp.Selection.endKey Unit:=6
            rng2.CopyPicture Appearance:=xlScreen, Format:=xlPicture
            wordApp.Selection.Paste
        End With
    

    enter image description here