Excel VBA グラフ作成

質問

グラフを複数、自動で作成しようと思っています。
データは、

がっつり
A　　１
B　　３
C　　５
D　　８
E　　１０

しっとり
A　　３
B　　５
・
・
・

最初に「しっとり」などのような項目名が記してあり、
その後5行はデータになっています。
Aを選択した人が3人、Bを選択した人が5人などの意味です。
A2からデータが入っており、
グラフを作る個数は決まっておらず、表の個数により作成したいと思っています。

「Sheet1」にグラフを自動で作成するにあたり、
３つ質問があります。

マクロに「SampleGraphという名称で作ってみました。」

-----------------
Sub Sample_Graph()
Dim i As Long
Dim SampleChart As Shape

i = 2
Set SampleChart = Worksheets("Sheet1").Shapes.AddChart

With SampleChart.Chart
.SetSourceData Range("'Sheet1'" & "A" & i + 1 & ":" & "B" & i + 6)
.ChartType = xlColumnClustered
.HasTitle = True
.ChartTitle.Text = Range("A" & i)
End With

i = i + 7

End Sub
------------------------------

質問１
実行すると、Set SampleChart = Worksheets("Sheet1").Shapes.AddChartのところで
エラー438が出ます。どうしてこのエラーが出るのでしょうか？
フォームにプログラムを書いて組んでいるのですが・・・
（フォームのボタン１をクリックしたら実行するようにしています）

質問2
グラフのサイズを決め、個数によって配置を変えたりしたいです。
Inputboxを使い、
”何列にしますか？”というメッセージを表示
そして、数値を入力すると
3列でグラフ表示される

質問3
図のように、項目名とは別に
「Yes」「No」などを表示させたいです。
データに含むとおかしくなりますし、
かといってタイトルや系列名を変えることも難しいかと。

何か良い方法はありませんか？

以上、質問3点長々と書かせて頂きました。
分かりにくい点が多々ありますが、よろしくお願い致します。
せめて、グラフを作れるようにはなりたいと思っています！

回答No.4

mitarashi · ベストアンサー

#3です。
>グラフデータ範囲選択部分の説明をよろしくお願い致します。
と言われても、データ範囲は決め打ちで選択してはいません。指定セルから、データがあるところまで下ったところを選択し、列範囲を３列に拡張しているだけです。

ご提示のデータ配置で、データ範囲選択を簡便に行う例です。（技法に走って、まじめにループを回す能力の低下を感じる今日この頃です）
若干のコメントは入れましたので、後は解読していただかないと、応用が利かないと存じます。
Sub test()
Dim dataRange As Range, myArea As Range, targetRange As Range
Dim sh As Worksheet
Dim Counter As Long, graphColumns As Long
Dim myLeft As Double, myTop As Double, myWidth As Double, myHeight As Double
Dim xOffset As Double, yOffset As Double
Dim chartObj() As ChartObject

graphColumns = 3 'グラフを何列に並べるか
myWidth = 200: myHeight = 150
xOffset = 20: yOffset = 20
Set sh = ActiveSheet
With sh
Set dataRange = .Range(.Range("A2"), .Range("A" & .Rows.Count).End(xlUp))
End With
Counter = 0
'myAreaにA列で値が入っている一塊のセル範囲を取得
For Each myArea In dataRange.SpecialCells(xlCellTypeConstants).Areas
'取得した範囲の一行目を切り捨て、3列に拡大した範囲を取得
Set targetRange = Intersect(myArea, myArea.Offset(1, 0)).Resize(, 3)
myLeft = 150 + (Counter Mod graphColumns) * (myWidth + xOffset)
myTop = 10 + (Counter \ graphColumns) * (myHeight + yOffset)
'chartObjはループを回す毎の使い捨てでも可能だが、後々使う事を考えて配列に入れてみた
ReDim Preserve chartObj(0 To Counter)
Set chartObj(Counter) = sh.ChartObjects.Add(myLeft, myTop, myWidth, myHeight)
makeGraph targetRange, chartObj(Counter)
Counter = Counter + 1
Next myArea
End Sub

Sub makeGraph(myRange As Range, myChartObj As ChartObject)
Dim mySeries As Series
Dim i As Long

With myChartObj.Chart
Set mySeries = .SeriesCollection.NewSeries
mySeries.XValues = myRange.Columns(1)
mySeries.Values = myRange.Columns(2)
.ChartType = xlColumnClustered
.HasTitle = True
.HasLegend = False
.ChartTitle.Text = myRange.Cells(1).Item(0).Value
End With
For i = 1 To mySeries.Points.Count
With mySeries.Points(i)
.HasDataLabel = True
.DataLabel.Text = myRange.Columns(3).Cells(i).Value
End With
Next i
End Sub

お礼

回答ありがとうございます！
マクロを実行した際に、
思ったとおりのものが一瞬で出来上がり、
鳥肌が立ちました・・・！

データ範囲選択は、
For Each myArea In dataRange.SpecialCells(xlCellTypeConstants).Areas
のところで、
A列の空白が出るまでのエリアを取得という
感じでしょうか。
そして、その範囲を取得したら
横に広げるといった感じでしょうか・・・？

なんとなく、少しずつですが分かってきました！
回答ありがとうございました。
本当に助かりました！

回答No.3

mitarashi

#2です。
ご質問のシートの構造では、.Range("A" & .Rows.Count).End(xlUp)は不適切でした。
データ群の間に、空行があるなら、End(xlDown)で良いです。
また、グラフの設定部は別の関数にする方が、沢山設置する場合にはやりやすいでしょう。
どこまで別関数にするかは色々な考え方があると思いますが、一例です。ご参考まで。

Sub test()
Dim sh As Worksheet
Dim targetRange As Range, myTopLeftCell As Range
Dim chartObj As ChartObject
Dim myLeft As Double, myTop As Double, myWidth As Double, myHeight As Double

myLeft = 200
myTop = 10
myWidth = 430
myHeight = 300
Set sh = ActiveSheet
With sh
Set myTopLeftCell = .Range("A2")
Set targetRange = .Range(myTopLeftCell, myTopLeftCell.End(xlDown)).Resize(, 3)
End With
Set chartObj = sh.ChartObjects.Add(myLeft, myTop, myWidth, myHeight)
makeGraph targetRange, chartObj
End Sub

Sub makeGraph(myRange As Range, myChartObj As ChartObject)
Dim mySeries As Series
Dim i As Long

With myChartObj.Chart
Set mySeries = .SeriesCollection.NewSeries
mySeries.XValues = myRange.Columns(1)
mySeries.Values = myRange.Columns(2)
.ChartType = xlColumnClustered
.HasTitle = True
.HasLegend = False
.ChartTitle.Text = myRange.Cells(1).Item(0).Value
End With
For i = 1 To mySeries.Points.Count
With mySeries.Points(i)
.HasDataLabel = True
.DataLabel.Text = myRange.Columns(3).Cells(i).Value
End With
Next i
End Sub

補足

回答ありがとうございます。

記入し忘れていましたが、実際のデータは
A1:シート名

A2：タイトル
A3~A7：データ

A9：タイトル
A10~A14：データ

・
・
という感じでデータが並んでいます。

頂いたコードを実行してみたところ、
A1に記入されているシート名もグラフの系列に
入ってしまいました。

とても申し訳ないのですが、
プログラムの説明をお願いできますでしょうか？

グラフのデータ範囲の設定の部分のみでも構いませんので
時間のあるときによろしくお願い致します。

回答No.2

mitarashi

ご提示のコードは生かしていませんが、データラベルをいじると、数値の代わりに任意の文字列を表示できます。

>質問2
>グラフのサイズを決め、個数によって配置を変えたりしたいです。

個々の表をどの様に認識するかが不明ですので、具体的な事は言えませんが、下記コードのmyLeftのところを、グラフを何列目に設置するかによって変化させれば、グラフをマトリクス状に配置する事は可能です。
Sub test()
Dim chartObj As ChartObject
Dim sh As Worksheet
Dim mySeries As Series
Dim targetRange As Range
Dim myLeft As Double, myTop As Double, myWidth As Double, myHeight As Double
Dim i As Long

myLeft = 200
myTop = 10
myWidth = 430
myHeight = 300
Set sh = ActiveSheet
With sh
Set targetRange = .Range(.Range("A2"), .Range("A" & .Rows.Count).End(xlUp)).Resize(, 3)
End With
Set chartObj = sh.ChartObjects.Add(myLeft, myTop, myWidth, myHeight)
With chartObj.Chart
Set mySeries = .SeriesCollection.NewSeries
mySeries.XValues = targetRange.Columns(1)
mySeries.Values = targetRange.Columns(2)
.ChartType = xlColumnClustered
.HasTitle = True
.HasLegend = False
.ChartTitle.Text = targetRange.Cells(1).Item(0).Value
End With
For i = 1 To mySeries.Points.Count
With mySeries.Points(i)
.HasDataLabel = True
.DataLabel.Text = targetRange.Columns(3).Cells(i).Value
End With
Next i
End Sub

補足

上記補足、間違えておりました。
”A2”という部分を”A3”と変更することにより
１つ、求めるグラフを作成することができました。

そして、申し訳ないのですが
グラフデータ範囲選択部分の説明をよろしくお願い致します。

回答No.1

mt2008

取りあえず修正してみました。

回答1.「エラー438」はこちらの環境では出ませんでした。
提示のコードは実際のコードのコピペですか？そうでないならどこかにタイプミス等があったりするのでは？

回答2.最初からデータ数によってデータ範囲を変えればよいのでは？

回答3.Excel2013から追加された「データ ラベル フィールドの挿入」を使えば出来そうです。
　　　当方の環境は2010なので試せていません。悪しからず。

Sub Sample_Graph()
　　Dim i As Long
　　Dim SampleChart As Shape
　　dim nDatCount as long 'データ数

　　i = 2
　　Set SampleChart = Worksheets("Sheet1").Shapes.AddChart
　　nDatCount = WorksheetFunction.CountA(Worksheets("Sheet1").Range("A2:A6"))
　　With SampleChart.Chart
　　　　.SetSourceData Range("A" & i & ":" & "B" & i + nDatCount - 1)
　　　　.ChartType = xlColumnClustered
　　　　.HasTitle = True
　　　　.ChartTitle.Text = Range("A" & i - 1)
　　　　.Legend.Delete
　　End With
End Sub

お礼

回答ありがとうございます。
Set SampleChart = Worksheets("Sheet1").Shapes.AddChart
のところでエラー438が出ます。
Sheet1は作成済みですし、何が問題だかわかりません…