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

Question

我正在尝试将定义的Excel区域作为图像(PNG)导出到我的本地文件中(在“摘要”区域: P1:AI92上命名为“Print_Area”)。程序运行良好，但是当我打开文件时，所有的想象都是空白的，下面是我使用的代码：

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

When I open the file

Answer 1

在Excel2016中，粘贴操作前需要使用.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

Answer 2

我在office 2016中遇到了同样的问题。这似乎是一个时机问题。当创建Chart对象并能够粘贴到该对象时。如果我单步执行代码，它会按预期工作并生成我的图像。

我想出了一个似乎有效的修复方法:由于某些原因，在调用粘贴之前选择图表的父形状可以纠正该问题。

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