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

Question

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

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

end-u · Accepted Answer

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は該当セルをダブルクリックすると実行されるイベントです。

end-u · Answer

グラフを重複作成しないように、事前に既存グラフを調べてます。簡易的にですが。

>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 に対して処理しています。

end-u · Answer

下記のようなテストコードで確認しましたが、
質問文に書かれたような、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.Add からLocationメソッドでシート上にグラフを移動した場合、

この回答への補足

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

下記のようなテストコードで確認しましたが、

この回答への補足

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング