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?
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