2本ある折れ線グラフの範囲をVBAで更新したい

質問

2本ある折れ線グラフの範囲をVBAで更新したいと考えております。
excel2003を使っています。

グラフ1の中に系統がひとつなら以下の内容でうまくいきますが、2本ある場合どうすれば
良いか分からず困っております。

Sub サンプル()
Dim myPicture As StdPicture
Dim buf As String
Dim myR
With Worksheets("Sheet1")
myR = Application.WorksheetFunction.Count(Worksheets("Sheet1").Range("A5:A100"))
End With
row1 = "5"
row2 = myR
col1 = "A"
Sheets("Sheet2").Activate
ActiveSheet.ChartObjects("グラフ 1").Activate
ActiveChart.ChartArea.Select
ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range(col1 & row1 & ":" & col1 & row2 + 4), PlotBy:=xlColumns

End Sub

系統を増やした場合の書き方をどなたかお教え頂けませんか。

どうぞ、よろしくお願い致します。

回答No.1

keithin · ベストアンサー

基本的なマクロは，次のように手がかりを得られます。

手順：
シート２に，２系列載せた折れ線グラフを描いておく
新しいマクロの記録を開始する
グラフの系列１を右クリックして，元のデータから系列タブで値欄のセル範囲を実際に書き換えてみる
続けて系列２についても元のデータの系列タブで新しいセル範囲に付け替えてみる
記録終了し，採取できたマクロを分析する

で。そこで記録されたvaluesプロパティのヘルプを確認し，使用例を参考にしてみると結局次のようなマクロでよい事が見えてきます。

作成例：
シート１のA列に「項目軸」のデータが並ぶ
Ｂ列に系列１の値データが並ぶ
Ｃ列に系列２の値データが並ぶ
いずれも４行目はタイトル行で，５行目から実データである
シート２にグラフ１が作成済みである。

sub macro1()
　dim r as long
　r = worksheets("Sheet1").range("B65536").end(xlup).row
　with worksheets("Sheet2").chartobjects("グラフ 1").chart
　　.seriescollection(1).values = worksheets("Sheet1").range("B5:B" &r)
　　.seriescollection(2).values = worksheets("Sheet1").range("C5:C" &r)
　　.seriescollection(1).xvalues = worksheets("Sheet1").range("A5:A" & r)
　end with
end sub

お礼

やりたいことが、そのまましっかりできました。

ありがとうございました。