グラフを作成して、そのグラフを画像ファイルとして出力します。
サイズや使い勝手を考えると、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


コメント