将所有图表导出为图形

我试图找到一种方法，可以将所有图表从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

这将导出活动图表，但如何导出所有图表？如果图表以他们来自的工作表命名，则为奖励点。

来源

2013-02-27 fromabove

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-27 21:26:44

什么是文件名中“_1”的基本原理？ – fromabove 2013-02-28 14:39:29

如果一张纸上有多张图表，则不能给他们相同的文件名......从您的问题中不清楚您有多少图表。 – 2013-02-28 16:04:20

在这种情况下，每张表只有一张图表，但呼叫良好。谢谢你的帮助！ – fromabove 2013-02-28 17:57:22

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

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

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-27 21:31:50 mooseman

将所有图表导出为图形

回答

相关问题