【VBA】埋め込みグラフを作成し、パーツの設定を行う
<機能>
(1)アクティブシートにテスト用の表を自動作成します
過去5年間のパリーグ勝利数
出典:日本野球機構 年度別成績
(2)埋め込みグラフを作成します(表と同じシートに作成)
(3)グラフのパーツを設定します
<動作検証&開発環境>
Microsoft Office 2016
<使い方>
適当なところにソースを張り付けてください
VBAでグラフを作成する()を呼び出すと埋め込みグラフ作成処理を開始します
<実行イメージ>
テスト表を作成し、左50、トップ250位置よりグラフを出力します
'********************************************
'VBAでグラフを自動作成する
'(1)アクティブシートにテスト用の表を作成
'(2)埋め込みグラフを作成(表と同じシートにグラフを作成)
'(3)グラフのパーツを設定する
'********************************************
Sub VBAでグラフを作成する()
Dim gyo As Long
Dim clm As Long
'//(1)テストデータ「過去5年間のパリーグ勝利数」表を作成
SetTestData
'//データの入っている最終行、最終列を取得
gyo = Cells(Rows.Count, 1).End(xlUp).Row
clm = Cells(1, Columns.Count).End(xlToLeft).Column
'//(2)埋め込みグラフを作成
'// 左:50 トップ:250 幅:500 高さ:350
Set co = ActiveSheet.ChartObjects.Add(50, 250, 500, 350)
'// グラフの種類は「積み上げ縦棒」
'// グラフの種類についてはOffice Dev Centerを参照
co.Chart.ChartType = xlColumnStacked
'// グラフのデータソースを指定
co.Chart.SetSourceData Source:=Range(Cells(1, 1), Cells(gyo, clm))
'//(3)グラフパーツの設定
'// グラフのタイトルを表示
co.Chart.HasTitle = True
'// グラフのタイトルを設定
co.Chart.ChartTitle.Font.Name = "メイリオ"
co.Chart.ChartTitle.Text = "過去5年間のパリーグ勝利数"
'// 軸ラベルの書式設定
'// AxesのxlCategoryはX軸、xlValueはY軸
co.Chart.Axes(xlCategory).TickLabels.Font.Name = "メイリオ"
co.Chart.Axes(xlCategory).TickLabels.Font.Size = 9
co.Chart.Axes(xlValue).TickLabels.Font.Name = "メイリオ"
co.Chart.Axes(xlValue).TickLabels.Font.Size = 9
'// 軸の表示方向を指定する
'// 反時計回りの角度を指定(マイナスを指定すると時計回り)
co.Chart.Axes(xlCategory).TickLabels.Orientation = 45
co.Chart.Axes(xlValue).TickLabels.Orientation = 0
'// 凡例を表示
co.Chart.HasLegend = True
'// 凡例の位置を指定(下に表示)
co.Chart.Legend.Position = xlLegendPositionTop
'xlLegendPositionBottom 下
'xlLegendPositionCorner 右上
'xlLegendPositionLeft 左
'xlLegendPositionRight 右
'xlLegendPositionTop 上
'// 背景色に緑(204, 255, 204)をセット
co.Chart.ChartArea.Interior.Color = RGB(204, 255, 204)
'// 枠線(二点鎖線)をセット
co.Chart.ChartArea.Border.LineStyle = xlDashDotDot
'xlContinuous 実線 (細)
'xlDash 破線
'xlDashDot 一点鎖線
'xlDashDotDot 二点鎖線
'xlDot 点線
'xlDouble 二重線
'xlSlantDashDot 斜め斜線
'xlLineStyleNone 無し
End Sub
'********************************************
'アクティブシートに「過去5年間のパリーグ勝利数」表を作成する
'出典 日本野球機構 年度別成績
'********************************************
Sub SetTestData()
Dim ar As Variant
ar = Array( _
"チーム名,2011年,2012年,2013年,2014年,2015年", _
"福岡ソフトバンクホークス,88,67,73,78,90", _
"北海道日本ハムファイターズ,72,74,64,73,79", _
"千葉ロッテマリーンズ,54,62,74,66,73", _
"埼玉西武ライオンズ,68,72,74,63,69", _
"オリックス・バファローズ,69,57,66,80,61", _
"東北楽天ゴールデンイーグルス,66,67,82,64,57")
ThisWorkbook.Activate
Cells.Select
Selection.Clear
Selection.ColumnWidth = 15
Selection.RowHeight = 30
Selection.Font.Name = "MS ゴシック"
Selection.Font.Size = 10
'//折り返して全体を表示する
Selection.WrapText = True
Range("A1").Select
'//全てのグラフを削除
Dim objShape As Shape
For Each objShape In ActiveSheet.Shapes
objShape.Delete
Next
'//データをシートに展開
Dim i As Integer, j As Integer
Dim wkbuf As Variant
For i = 0 To UBound(ar)
wkbuf = Split(ar(i), ",")
'不正なデータであれば次レコードへ
If UBound(wkbuf) <> 5 Then GoTo nextrec
'データを表示
For j = 0 To UBound(wkbuf)
Cells(i + 1, j + 1) = wkbuf(j)
Next j
nextrec:
Next i
End Sub
よろしければポチッと押してください