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
我正在尝试将工作簿中命名范围的多张“图片”相互粘贴到Word文档中。然而,每次我运行宏时,“rng2”图像似乎都会覆盖“rng1”图像。
在Word中,仅显示“rng2”图像,如果我按Ctrl+Z,则会显示“rng1”图像,这让我相信该图像被覆盖。有解决这个问题的想法吗?
第二个
wordDoc.Content.Paste
用新图片替换Doc的内容(第二个)。
尝试
With wordDoc.Range
rng1.CopyPicture Appearance:=xlScreen, Format:=xlPicture
rng1.CopyPicture Appearance:=xlScreen, Format:=xlPicture
wordDoc.Content.Paste
wordDoc.Content.Characters.Last.InsertParagraphAfter
wordApp.Selection.endKey Unit:=6
rng2.CopyPicture Appearance:=xlScreen, Format:=xlPicture
wordApp.Selection.Paste
End With