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

Answer 2

快速而肮脏。
您希望将其放在代码的底部，以遍历工作表和每个工作表上的所有图表对象。

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

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

将所有图表导出为图形

2 个答案: