0

我正在尝试找到一种方法来轻松地将 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

这将导出活动图表,但如何导出所有图表?如果图表以它们来自的工作表命名,则可获得奖励积分。

4

2 回答 2

6
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
于 2013-02-27T21:26:44.380 回答
0

又快又脏。
您希望将其放在代码的底部以循环遍历工作表和每张工作表上的所有图表对象。

我没有对此进行测试,因为我没有时间重新创建您的文件或情况。希望这可以帮助

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
于 2013-02-27T21:31:50.300 回答