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 に答える