| |
mayu さん、おはようございます。
>今の状態でマクロを実行すると、「A上」の部分がグラフタイトルとなり1月から6月までの30〜80までの一本の折れ線グラフとなります。
>グラフにはA上とA下の値が二本の折れ線として表示されるグラフにしたいです。
>（続くB上B下〜同様）
A1の右下のセルの連続範囲がデータテーブルだとして作図しています。
もし、データテーブルの左上のセルがA1でない場合は、該当のセルのアドレスに変更してください。
Sub AddChartObjects()
Dim II As Integer, Imax As Integer
Dim ch As Chart, ws As Worksheet, r1 As Range, r2 As Range, se As Series
'データがアクティブシートにあるとする
Set ws = Application.ActiveSheet
'データの領域
Set r1 = ws.Range("A1").Offset(1, 1).CurrentRegion
'
Imax = (r1.Rows.Count - 1) \ 2 'グラフの最大個数
For II = 1 To Imax
'見出し＋データの行数
With r1
Set r2 = Application.Union(.Rows(1), .Rows(II * 2), .Rows(II * 2 + 1))
End With
'
With WorkSheets("グラフ用")
Set ch = .ChartObjects.Add(((II - 1) Mod 2) _
* 220 + 20, Int((II - 1) / 2) * 160 + 20, 200, 140).Chart
'
With ch
.SetSourceData Source:=r2
.ChartType = xlLine
.ChartArea.Font.Size = 6
.ChartArea.Interior.ColorIndex = 35
.PlotArea.Interior.ColorIndex = 37
.Axes(xlValue).MinimumScale = 0
.Axes(xlValue).MaximumScale = 100
.ApplyDataLabels AutoText:=True
.HasTitle = True
With .ChartTitle
.Text = r1.Rows((II * 2)).Cells(1).Value & "/" & r1.Rows((II * 2 + 1)).Cells(1).Value
.Font.Size = 8
End With
'系列の色
.SeriesCollection(1).Border.ColorIndex = 3 '系列１
.SeriesCollection(2).Border.ColorIndex = 5 '系列２
End With
End With
Next II
End Sub
こんな感じです。
|
|
りん
- 07/5/27(日) 6:11 -
