将所有图表导出为图形

Question

我试图找到一种方法轻松导出Excel中的工作簿中的所有图表作为图形.我有以下代码:

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