Oprava chýb: Skopírované obrázky v programe Excel 2016 VBA sa zobrazujú ako prázdne obrázky - Excel, Image, VBA

Snažím sa exportovať do svojho lokálneho súboru adefinovaný rozsah programu Excel ako obrázok (PNG) (na karte „Súhrn“ na karte „Summary“ (Názov: „Print_Area“): P1: AI92). Program funguje dobre, ale keď otvorím súbor, všetky jeho predstavy sú prázdne Tu je kódovanie, ktoré používam:

Sub _Daily_Mail()

Dim Rango7 As Range
Dim Archivo As String
Dim Imagen As Chart
Dim Result As Boolean

Set Rango7 = Sheets("Summary").Range("P2:AI92")   " Summary
Sheets("Summary").Select

With Rango7
.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set Imagen = Rango7.Parent.ChartObjects.Add(33, 39, .Width, .Height).Chart
End With

Imagen.Paste
Imagen.ChartArea.Border.LineStyle = 0
Imagen.ChartArea.Width = Imagen.ChartArea.Width * 3
Imagen.ChartArea.Height = Imagen.ChartArea.Height * 3

Imagen.export "C:UsersmelyDocumentsImagenes_POSInforme1.png", filtername:="PNG"
Imagen.Parent.Delete
Set Imagen = Nothing

Keď otvorím súbor

odpovede:

V programe Excel 2016 musíte pred operáciou vloženia použiť príkaz .Activate. Príklad:

Set rng = Range("A1:C1")

With rng
.CopyPicture xlPrinter, xlPicture

Set oChart = ActiveSheet.ChartObjects.Add(.Left, .Top, 1920, 1080)

oChart.Activate

With oChart.Chart
.ChartArea.Border.LineStyle = 0
.Paste
.Export Filename:="C:File.jpg", Filtername:="jpg"
.Parent.Delete
End With
End With

S Office 2016 sa stretávam s rovnakým problémom. Zdá sa, že ide o načasovanie. Pri vytváraní objektu grafu a možnosti vložiť ho. Ak prejdem kódom, funguje podľa očakávaní a vytvorí môj obraz.

Prišiel som s opravou, ktorá, zdá sa, funguje: Z nejakého dôvodu výber pôvodného tvaru grafu pred volaním na prilepenie problém opraví.

Function CopyRangeToPNG(ByRef rngImage As Range) As String
Dim vFilePath As Variant

rngImage.CopyPicture Appearance:=xlScreen, Format:=xlPicture

With rngImage.Parent.ChartObjects.Add( _
Left:=rngImage.Left, Top:=rngImage.Top, _
Width:=rngImage.Width + 2, Height:=rngImage.Height + 2)

With .Chart
.Parent.Select
.ChartArea.Format.Line.Visible = msoFalse
.Paste
With .Pictures(1)
.Left = .Left + 2
.Top = .Top + 2
End With
" export
.Export CStr(ThisWorkbook.Path & "ImageName.PNG")
End With
.Delete
End With
CopyRangeToPNG = ThisWorkbook.Path & "ImageName.PNG"

End Function