图表导出为图像生成一个空文件（有时）Excel VBA

我正在做一个macros，导出表格中的所有图表，然后打开Outlook并附加它们。 但是，我注意到，有几次图表会导出，但是作为0KB（该文件被创build，但图像不能被看到）

但是并没有发生在所有的图表上。 只是大多数，有时候，它们都是毫无问题地产生出来的。 （当我一步一步地执行代码，所有的图表生成没有问题，也执行一步一步后，然后我正常执行，所有图表生成，但如果我closures并重新打开工作簿，它会给出同样的问题，只生成两个，其余的都是空文件）

代码如下：

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

事实certificate，这是Excel 2010-2013用户的随机错误。 但是，更多的谷歌search之后。 我在这里遇到了答案

你只需要添加

 objChrt.Activate 

select图表后。 所以在我的情况下，最终的代码如下所示：

  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

我一直在经历像其他许多用户一样的问题。 经过多次试用，一些googleing，我发现EXCEL对图表的可见度，位置，大小都很敏感。 所以我想，从你的例子来看，只有Mychart6和Mychart7在屏幕上可见。

下面我把我今天使用的代码做成一个非常类似的任务。 到现在为止没有任何问题。

它是如何工作的：在单元格中的所有图表中循环移动图表，并且单元格的顶点重叠到单元格B2的顶部（应该可见）导出图表返回到原始位置范围B2：G13已经按顺序设置为范围对象如果需要的话，允许我pipe理不同维度的图表（设置与范围B2：G12的相同属性alignment的图表的高度和宽度属性）

 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