エクセルのシート上に、複数のグラフ表を作り、各グラフ表に対応したグラフ

質問

エクセルのシート上に、複数のグラフ表を作り、各グラフ表に対応したグラフを表示するマクロを作成しました。
エクセル2003のＰＣで作成したのですが、作成したＰＣでは良かったのですが、同じファイルをエクセル2010の端末に持ってきて表示したら問題が発生しました。対応方法を教えて下さい。

グラフの項目フィールドをP5:S5に置きます。
この下にグラフデータだけが追加されています。（１番目グラフデータP6:S12、２番目P13:S19、、、）
１番目のグラフはセルI6、２番目はI13に「グラフ表示」と記載し、それぞれのセルをクリックするとその都度マクロが起動してグラフが表示されます。クリックしたセルの右隣のセルがグラフの左上になる設定です。
ところが、エクセル2010では、最初に表示するグラフは意図した位置に表示されるのですが、次のグラフを表示すると、最初のグラフが次のグラフを表示すべき位置に移動し、次からのグラフはM16辺りを左上にして次々に重なってしまします。
対処策をご教示下さい。

回答No.2

end-u · ベストアンサー

2010では、Charts.Add からLocationメソッドでシート上にグラフを移動した場合、
Shape名称が全て『グラフ 1』になってしまうようです。
なので最低限の修正なら
>With ActiveSheet.Shapes(GName)
ここの、名前で指定しているところをインデックス指定に変えれば良いです。
With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)

以下は、参考までに回答#1と同じ書き方で書いた場合。
'SheetModule
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　　If ActiveCell.Value = "グラフ表示" Then
　　　　Call グラフ(ActiveCell)
　　End If
End Sub

Private Sub グラフ(ByVal Target As Range)
　　Dim c　　　As ChartObject
　　Dim r　　　As Range
　　Dim source As Range

　　Set r = Target.Offset(, 1).Resize(7, 6)
　　Set source = Union(Me.Range("P5:S5"), _
　　　　　　　　　　　 Target.Offset(, 7).Resize(7, 4))
　　For Each c In Me.ChartObjects
　　　　If Not Intersect(r, c.TopLeftCell) Is Nothing Then
　　　　　　Exit For
　　　　End If
　　Next
　　If c Is Nothing Then
　　　　Set c = Me.ChartObjects.Add(r.Left, r.Top, _
　　　　　　　　　　　　　　　　　　r.Width, r.Height)
　　End If
　　With c.Chart
　　　　.ChartType = xlColumnClustered
　　　　.SetSourceData source, xlRows
　　　　With .SeriesCollection(7)
　　　　　　.ChartType = xlLineMarkers
　　　　　　.AxisGroup = 2
　　　　End With
　　　　With .SeriesCollection(6)
　　　　　　.ChartType = xlLineMarkers
　　　　　　.AxisGroup = 2
　　　　End With
　　　　.Axes(xlValue, xlSecondary).DisplayUnit = xlMillions
　　　　.PlotArea.Interior.ColorIndex = xlNone
　　End With

　　Set c = Nothing
　　Set r = Nothing
　　Set source = Nothing
End Sub
こんな感じになります。

#ちなみに回答#1は該当セルをダブルクリックすると実行されるイベントです。

補足

大変ありがとうございました！
丁寧に書き下していただいたコードを利用させていただいたところ、バッチリでした。
Excel 2003,2007,2010いずれのバージョンでも動作しました。助かりました。
これは、今後もグラフ作成をマクロ化する上で、貴重な雛形になります。ChartObjectオブジェクト
の使い方も解った気がしています。

コードがスッキリ見易いうえ、Locationもないので描画の際に画面がチラつかないし、描画後も画面を
左にスクロールする必要もなくなり、良いことづくめです。

後学のためにお聞きしたいのですが、レンジrの中に、チャートcが描画されるのですが、
For Each c In Me.ChartObjects
のループのIf文では何をしているのでしょうか？

回答No.3

end-u

グラフを重複作成しないように、事前に既存グラフを調べてます。簡易的にですが。

>For Each c In Me.ChartObjects
>　　If Not Intersect(r, c.TopLeftCell) Is Nothing Then
>　　　　Exit For
>　　End If
>Next
>If c Is Nothing Then
>　　Set c = Me.ChartObjects.Add(r.Left, r.Top, _
>　　　　　　　　　　　　　　　　r.Width, r.Height)
>End If

http://msdn.microsoft.com/ja-jp/library/bb978779%28office.12%29.aspx#bb978779_topic5
Intersectメソッドを使って、r範囲に、グラフの左上セルが含まれているか判定し、
含まれていれば途中でLoopを抜けます。
途中で抜けたら c はSetされたままです。つまり既存グラフがある。
最後までLoopしたら、c はNothingになります。既存グラフはない。
ない場合だけグラフを追加して c にSetします。
以降、 c に対して処理しています。

お礼

なるほど。そういうことでしたか。
いろいろ、勉強させていただきました。
このたびは大変助かりました。ありがとうございました。
また、なにか機会がありましたら、どうぞよろしくお願いいたします。

回答No.1

end-u

下記のようなテストコードで確認しましたが、
質問文に書かれたような、2003・2010のバージョン差異は特に確認できません。
コードにもよるのではないでしょうか。
SelectやActivateに依存した書き方になっていませんか？
必要であればコード提示してみてください。

'SheetModule
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
　　　　　　　　　　　　　　　　　　　　Cancel As Boolean)
　　With Target
　　　　If .Column = 9 Then
　　　　　　If .Row > 5 And .Row < 35 Then 'Click範囲
　　　　　　　　If .Row Mod 7 = 6 Then
　　　　　　　　　　Cancel = True
　　　　　　　　　　Call test1(Target)
　　　　　　　　End If
　　　　　　End If
　　　　End If
　　End With
End Sub

Private Sub test1(ByVal Target As Range)
　　Dim c　　　As ChartObject
　　Dim r　　　As Range
　　Dim source As Range

　　With Me
　　　　Set r = Target.Offset(, 1).Resize(7, 6)
　　　　Set source = Union(Range("P5:S5"), _
　　　　　　　　　　　　　 Target.Offset(, 7).Resize(7, 4))
　　　　For Each c In .ChartObjects
　　　　　　If Not Intersect(r, c.TopLeftCell) Is Nothing Then
　　　　　　　　Exit For
　　　　　　End If
　　　　Next
　　　　If c Is Nothing Then
　　　　　　Set c = .ChartObjects.Add(r.Left, r.Top, _
　　　　　　　　　　　　　　　　　　　r.Width, r.Height)
　　　　End If
　　　　c.Chart.SetSourceData source
　　End With

　　Set c = Nothing
　　Set r = Nothing
　　Set source = Nothing
End Sub

※とりあえずDoubleClickイベントコード。
　.Row < 35...ここはデータ範囲に合わせて修正する必要がありますし
　Chart種別についても追加設定が必要な場合もあります。

お礼

問題のコードを補足として上記掲載させていただきました。文字数制限のためコメントが書けず申し訳ありませんでした。これで問題をご指摘頂ければ幸いです。
なお、最初に頂いたご回答のコードは大変美しくてこれが使えればよいと思って、現行のシートモジュール（起動用マクロ）を戴いたコードに置き換えてみたのですが、「グラフ表示」のセルをクリックしてみましたが何も起きませんでした。多分、グラフを書く詳細の部分がないからでしょうか？

私は、マクロの記録から始めて、少しづつ手直しで進めてきてやっとうまく行ったと思ったのですが、2010で読み込んだ途端、動いてしまったのでガッカリしていました。

マクロの記録を使うと、Chartsオブジェクトでグラフシートを作り、これをワークシートに戻す、
というようなことをしているらしいですね。書籍などでは、end-uさんのようにChartObjectsを使って埋め込むのが一般的みたいですが、Chartsを前提としたコードからChartObjectsを前提としたコードに書き換える方法がよく解りませんので、頂いたコードで修正を完遂できない状態です。

以上ですが、いずれかの方法でうまく行くようにしたいと思いますので、どうかよろしくお願いします。

補足

お願いします。
起動用マクロ
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim MyRow As Long
Dim MyCol As Integer
MyRow = Target.Row
MyCol = Target.Column
If ActiveCell.Value = "グラフ表示" Then
グラフ
End If
End Sub
次にグラフ表示マクロ
Sub グラフ()
Dim Wsh As Worksheet
Set Wsh = Worksheets("クロス集計")
Graph_left = ActiveCell.Offset(0, 1).Address
Datas = ActiveCell.Offset(0, 7).Resize(7, 4).Address
Application.Union(Wsh.Range("P5:S5"), Wsh.Range(Datas)).Select
Range("P5").Activate
Charts.Add
With ActiveChart
.ChartType = xlColumnClustered
.SetSourceData Source:=Sheets("クロス集計").Application.Union(Wsh.Range("P5:S5"), Wsh.Range(Datas)), _
PlotBy:=xlRows
.Location Where:=xlLocationAsObject, Name:="クロス集計"
End With
ActiveChart.SeriesCollection(7).Select
With Selection
.ChartType = xlLineMarkers
.AxisGroup = 2
End With
ActiveChart.SeriesCollection(6).Select
With Selection
.ChartType = xlLineMarkers
.AxisGroup = 2
End With
ActiveChart.Axes(xlValue, xlSecondary).Select
With ActiveChart.Axes(xlValue, xlSecondary)
.MinimumScaleIsAuto = True
.MaximumScaleIsAuto = True
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlMillions
.HasDisplayUnitLabel = True
End With
ActiveChart.PlotArea.Select
With Selection.Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With
Selection.Interior.ColorIndex = xlNone
GName = Mid(ActiveChart.Name, Len(ActiveSheet.Name) + 2)
With ActiveSheet.Shapes(GName)
.Top = Range(Graph_left).Top
.Left = Range(Graph_left).Left
.Width = 300
.Height = 200
End With
Range(Graph_left).Offset(0, -8).Select
ActiveWindow.Visible = False
Windows("シートを含むブックの名前.xls").Activate
End Sub