将所有图表导出为graphics

我正在试图find一种方法，可以将所有图表从Excel中的工作簿导出为graphics。 我有以下代码：

Option Explicit Sub ExportChart() ' Export a selected chart as a picture Const sSlash$ = "/" Const sPicType$ = ".png" Dim sChartName$ Dim sPath$ Dim sBook$ Dim objChart As ChartObject On Error Resume Next ' Test if there are even any embedded charts on the activesheet ' If not, let the user know Set objChart = ActiveSheet.ChartObjects(1) If objChart Is Nothing Then MsgBox "No charts have been detected on this sheet", 0 Exit Sub End If ' Test if there is a single chart selected If ActiveChart Is Nothing Then MsgBox "You must select a single chart for exporting ", 0 Exit Sub End If Start: sChartName = Application.InputBox("Please Specify a name for the exported chart" & vbCr & _ "There is no default name available" & vbCr & _ "The chart will be saved in the same folder as this file", "Chart Export", "") ' User presses "OK" without entering a name If sChartName = Empty Then MsgBox "You have not entered a name for this chart", , "Invalid Entry" GoTo Start End If ' Test for Cancel button If sChartName = "False" Then Exit Sub End If ' If a name was given, chart is exported as a picture in the same ' folder location as their current file sBook = ActiveWorkbook.Path sPath = sBook & sSlash & sChartName & sPicType ActiveChart.Export Filename:=sPath, FilterName:="PNG" End Sub 

这将导出活动图表，但我怎样才能导出所有图表？ 如果图表是在他们来自的工作表之后命名的，奖励点数。

Answer 1

 Sub Test() Dim sht As Worksheet, cht As ChartObject Dim x As Integer For Each sht In ActiveWorkbook.Sheets x = 1 For Each cht In sht.ChartObjects cht.Chart.Export "C:\local files\temp\" & sht.Name _ & "_" & x & ".png", "PNG" x = x + 1 Next cht Next sht End Sub 

Answer 2

快速和肮脏。
你想把它放在你的代码底部循环工作表和每个工作表上的所有图表对象。

我没有testing这个，因为我没有时间来重新创build你的文件或情况。 希望这可以帮助

 For each x in worksheets.count then For Each objChart In ActiveSheet.ChartObjects then sChartName = activesheet.name sBook = ActiveWorkbook.Path sPath = sBook & sSlash & sChartName & sPicType ActiveChart.Export Filename:=sPath, FilterName:="PNG" Next objChart Next x