错误修复：在Excel 2016 VBA中复制的图像显示为空白图像

我试图导出到我的本地文件定义的Excel范围作为图像（PNG）（它被命名为：“Print_Area”选项卡“摘要”范围：P1：AI92）。 该程序运行良好，但是当我打开文件所有的想象都是空白的这里是我使用的编码：

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:\Users\mely\Documents\Imagenes_POS\Informe1.png", filtername:="PNG" Imagen.Parent.Delete Set Imagen = Nothing 

当我打开文件

Answer 1

我在2016年遇到了同样的问题。这似乎是一个时间问题。 创build图表对象并能够粘贴到它。 如果我单步执行代码，按预期工作，并生成我的图像。

我想出了一个似乎工作的修复：出于某种原因，在调用粘贴之前select图表的父形状可以纠正问题。

 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 

Answer 2

在Excel 2016中，您需要在粘贴操作之前使用.Activate命令。 例：

 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