グラフを画像ファイルに出力

グラフを作成して、そのグラフを画像ファイルとして出力します。
サイズや使い勝手を考えると、PNG一択かと思いますが、サンプルプログラムでは、PNG、ビットマップ、Jpeg、GIFの 4種類を出力しています。

【サンプルプログラム】
グラフの作成を基に作成しています。


Sub Graph_Create()
    Dim this_wb As Workbook
    Dim in_wb As Workbook
    Dim in_ws As Worksheet
    Dim out_wb As Workbook
    Dim out_ws As Worksheet
    Dim out_data_ws As Worksheet
    
    Dim in_filename As String
    Dim in_sheetname As String
    Dim out_filename As String
    Dim graph_title As String

    Dim graph_range As String
    Dim g_chart As Chart
    Dim x_pos As Long
    Dim y_pos As Long
    Dim img_filename As String


    ' VBA マクロを実行しているワークブックを取得
    Set this_wb = ThisWorkbook
    
    ' Sheet1 に設定情報を定義してあるので読み出し
    With this_wb.Sheets(1)
        in_filename = .Range("B1")
        in_sheetname = .Range("B2")
        out_filename = .Range("B3")
        graph_title = .Range("B4")
    End With


    ' 出力先のワークブックを作成
    Set out_wb = Workbooks.Add
    ' グラフを出力する Sheetを取得し、名前の変更
    Set out_ws = out_wb.Sheets(1)
    out_ws.Name = "グラフ"


    ' 入力元のワークブックを開く
    If IsFileExists(in_filename) = False Then   ' ファイルの有無を確認
        MsgBox in_filename & "は存在しません", vbExclamation
        Exit Sub
    End If
        
    ' ワークブックを開く
    Set in_wb = Workbooks.Open(in_filename)

    ' Sheet を出力先のワークブックにコピーする
    in_wb.Sheets(in_sheetname).Copy Before:=out_ws
    
    ' ブックを閉じる(保存しない)
    in_wb.Close SaveChanges:=False
    
    ' データのSheetを保持しておく
    Set out_data_ws = out_wb.Sheets(in_sheetname)

    ' データ部の範囲
    graph_range = in_sheetname & "!" & "A1:" & _
                    GetLastColumnStr(out_data_ws) & GetLastRowStr(out_data_ws)
    
    ' グラフを表示するシートをアクティブにします
    out_ws.Activate


    ' ----------------------------------------------
    ' 折れ線グラフの作成
    
    ' チャートの追加
    Set g_chart = out_ws.Shapes.AddChart2(227, xlLine).Chart
    
    ' データの設定
    g_chart.SetSourceData Source:=Range(graph_range)
    ' タイトルの変更
    g_chart.ChartTitle.Text = graph_title
    ' 凡例の表示
    g_chart.SetElement (msoElementLegendBottom)
    
    ' グラフ表示位置 (B2から開始)
    x_pos = 2
    y_pos = 2
    
    With g_chart.ChartArea
        ' グラフの左端を変更
        .Left = out_ws.Range(Cells(y_pos, x_pos).Address).Areas.Item(1).Left
        ' グラフの上端を変更
        .Top = out_ws.Range(Cells(y_pos, x_pos).Address).Areas.Item(1).Top
        ' グラフの幅を変更
        .Width = 500
        ' グラフの高さを変更
        .Height = 250
    End With
    
    ' グラフを画像として出力 (グラフのRangeを選択しておかないと 0バイトで出力されることがあるため)
    img_filename = "C:\ExcelVBA\グラフ\果物出荷数_折れ線グラフ.png"
    out_ws.Range(Cells(y_pos, x_pos).Address).Select
    g_chart.Export filename:=img_filename, filtername:="PNG"

    img_filename = "C:\ExcelVBA\グラフ\果物出荷数_折れ線グラフ.bmp"
    out_ws.Range(Cells(y_pos, x_pos).Address).Select
    g_chart.Export filename:=img_filename, filtername:="BMP"

    img_filename = "C:\ExcelVBA\グラフ\果物出荷数_折れ線グラフ.jpg"
    out_ws.Range(Cells(y_pos, x_pos).Address).Select
    g_chart.Export filename:=img_filename, filtername:="JPG"

    img_filename = "C:\ExcelVBA\グラフ\果物出荷数_折れ線グラフ.gif"
    out_ws.Range(Cells(y_pos, x_pos).Address).Select
    g_chart.Export filename:=img_filename, filtername:="GIF"

End Sub

コメント