将图表导出为图像有时会生成空文件

Question

我正在执行一个宏，导出工作表中的所有图表，然后打开 Outlook 并附加它们。但是，我注意到，有几次图表确实导出，但大小为 0KB（文件已创建，但看不到图像）

但并非所有图表都会发生这种情况。只是其中的大多数，有时，它会毫无问题地生成所有这些。 （当我一步一步执行代码时，所有图表都会毫无问题地生成，而且在一步一步执行之后，然后我正常执行它并生成所有图表，但是如果我关闭并重新打开工作簿，则会出现相同的问题，只生成两个，其余都是空文件）

这是代码：

Dim sheetNumber, Size, i As Integer
    Dim chartNames(), FNames() As String
    Dim objChrt As ChartObject
    Dim myChart As Chart


    'Activate Charts Sheet
    Sheets("GRAFICAS").Activate
    'Calculate Number of Charts in Sheet
    Dim chartNumber
    chartNumber = ActiveSheet.ChartObjects.Count
    'Redimension Arrays to fit all Chart Export Names
    ReDim chartNames(chartNumber)
    ReDim FNames(chartNumber)
    'Loops through all the charts in the GRAFICAS sheet
    For i = 1 To chartNumber
        'Select chart with index i
        Set objChrt = ActiveSheet.ChartObjects(i)
        Set myChart = objChrt.Chart
        'Generate a name for the chart
        chartNames(i) = "myChart" & i & ".png"

        On Error Resume Next
        Kill ThisWorkbook.Path & "\" & chartNames(i)
        On Error GoTo 0
        'Export Chart
        myChart.Export FileName:=Environ$("TEMP") & "\" & chartNames(i), Filtername:="PNG"
        'Save path to exported chart
        FNames(i) = Environ$("TEMP") & "\" & chartNames(i)
    Next i

我错过了什么？

Answer 1

事实证明，对于 Excel 2010-2013 用户来说，这是一个随机错误。 然而，经过更多的谷歌搜索。我在这里遇到了答案

您只需添加

objChrt.Activate

选择图表后。所以 就我而言，最终代码如下所示：

 For i = 1 To chartNumber
        'Select chart with index i
        Set objChrt = ActiveSheet.ChartObjects(i)
        objChrt.Activate
        Set myChart = objChrt.Chart
        'Generate a name for the chart
        chartNames(i) = "myChart" & i & ".png"

        On Error Resume Next
        Kill ThisWorkbook.Path & "\" & chartNames(i)
        On Error GoTo 0
        'Export Chart
        myChart.Export FileName:=Environ$("TEMP") & "\" & chartNames(i), Filtername:="PNG"
        'Save path to exported chart
        'Application.Wait (Now + #12:00:01 AM#)
        FNames(i) = Environ$("TEMP") & "\" & chartNames(i)
    Next i

Answer 2

经过一番绞尽脑汁后，看来要导出的图表需要位于嵌入它的工作表的可见区域内。该工作表不需要可见，但如果嵌入图表的工作表是 ActiveSheet，则图表需要位于可见区域内。 否则会写入空文件。

Answer 3

在 C# 中的 Office 2016 和 Office 365 中，函数“Activate()”也解决了同样的问题：

Excel.ChartObjects xlCharts = Excel.ChartObjects)worksheet.ChartObjects(Missing.Value);
Excel.ChartObject myChart = (Excel.ChartObject)xlCharts.Item(1);

myChart.Activate();

Excel.Chart chart = myChart.Chart;
chart.Export(outputFile, "PNG", false);

Answer 4

和许多其他用户一样，我似乎也遇到过同样的问题。 经过多次试验，一些谷歌搜索，我发现EXCEL对图表的可见性、位置、大小很敏感。 所以我猜，从你的例子来看，只有 Mychart6 和 Mychart7 在屏幕上可见。

下面我放置了我今天用于执行非常类似任务的代码。到目前为止，没有任何问题。

它是如何工作的： 在sheet33中的所有图表中循环 移动图表，左上角与单元格 B2 的左上角重叠（应该是可见的） 导出图表 移回到原来的位置 范围 B2:G13 已设置为范围对象，以便允许我在需要时管理不同维度的图表（将图表的 .height 和 .width 属性设置为与范围 B2:G12 的相同属性对齐）

Sub export_kpi()

    On Error Resume Next

    Dim pd As String
    Dim ob As ChartObject
    Dim intervallo_riferimento As Range
    Dim temp_top As Double
    Dim temp_left As Double

    Set intervallo_riferimento = Sheet33.Range("B2:G13")

    pd = "//best-collab.st.com/ws/PC_R2/images1/kp"

    For Each ob In Sheet33.ChartObjects

        temp_top = ob.Top
        temp_left = ob.Left

        ob.Top = intervallo_riferimento.Top
        ob.Left = intervallo_riferimento.Left

        ob.Chart.Export pd & ob.Index & ".jpg", "jpg"

        ob.Top = temp_top
        ob.Left = temp_left

    Next ob

    ExportImage Sheet33.Range("B27:G38"), pd & "0.jpg"

End Sub

Answer 5

我有同样的问题，但是，我没有遇到任何错误：1）“错位”或2）空图表，或3）仅基于导出前图表的激活。 我检查了这些线程：Link1和[Link2][3]，似乎即使激活图表，错误仍然出现（有点随机，但对于较大的文件更频繁）（我知道这一点，因为我也打印图表组的 pdf（工作完美）。pfd 有点不同，因为它们还包含一个框架（单元格 A1：K50）。

我已经尝试了链接中的一些提示：

1. 导出前激活图表

2. 从导出命令中删除“过滤器名称部分”：

temporaryChrtObj.Chart.Export Filename:=strFilePathName,'Filtername:="PNG"

（放弃最后一部分）

3. 导出后：删除对象，然后从“locals”中删除其内容。

temporaryChrtObj.delete: set temporaryChrtObj=nothing

4. 让程序在代码中的某些位置进行渲染：

Application.Wait (Now + TimeValue("0:00:03"))

5. link2 中的一个提示（我没有尝试过）是将区域计算机设置更改为美国。

我尝试过 1)、2)、3) 和 4)，还有我自己建议的一些方法： 6）缩小一点，使打印文件更小（这也会使打印更粗糙/更像素化）。 例如。使用

ActiveWindow.Zoom = 180

代替

ActiveWindow.Zoom = 250

仍然出现错误:(

我在这里有点绝望。

好的，正如我的评论中所见。 2，我做了一个“修复”，代码有点大，特别是所有这些尝试都解决了这个问题：

Answer 6

Se me ha do el Problema usando la instrucción Range (graph).select antes de exportarlo (me cercioré de que los gráficos ocupen celdas Enteras, estirándolos con left Alt key.

For i = 1 To 8
        Set ch = .ChartObjects("GRAPH-5" & i)
        ActiveSheet.Range(ch.TopLeftCell, ch.BottomRightCell).Select
        ch.Width = IIf(ch.Name = "GRAPH-57", 620, 1976)
        ch.Height = IIf(ch.Name = "GRAPH-57", 620, 1221)
        rutaDirectorio = rutaDirectorio & ch.Name & ".jpg"
        ch.Chart.Export rutaDirectorio
        rutaDirectorio = Worksheets("DEFINITIONS").Range("C29").Value
    Next i