ＶＢＡにて、グラフのデータ範囲を取得したい

ＶＢＡにて
グラフをクリックして、アクティブにした状況にて、
マクロを走らせると、グラフを描くのに用いたX軸とY軸のデータの
セル上の番地を教えてくれるマクロが分かれば教えてください。

No.1 ベストアンサー 回答者： end-u 回答日時： 2009/10/02 21:34

安直だけど、系列のFormulaプロパティのSERIES関数文字列を分割して調査する方法があります。

Option Explicit

Sub test()
　　Dim filed() As String
　　Dim ret()　 As String
　　Dim v()　　 As String
　　Dim s()　　 As String
　　Dim cnt　　 As Long
　　Dim cx　　　As Long
　　Dim ub　　　As Long
　　Dim n　　　 As Long
　　Dim i　　　 As Long
　　Dim j　　　 As Long
　　Dim k　　　 As Long
　　
　　If ActiveChart Is Nothing Then
　　　　MsgBox "グラフを選択して実行"
　　　　Exit Sub
　　End If
　　
　　'項目名セット
　　filed() = Split("name category_labels values order size")
　　With ActiveChart
　　　　'BubbleChartの時
　　　　If (.ChartType = xlBubble) Or (.ChartType = xlBubble3DEffect) Then
　　　　　　cx = 4
　　　　Else
　　　　　　cx = 3
　　　　End If
　　　　
　　　　'アドレス文字格納配列サイズ決定
　　　　cnt = .SeriesCollection.Count
　　　　ReDim ret(0 To cnt, 0 To cx) As String
　　　　For i = 0 To cx
　　　　　　ret(0, i) = filed(i)
　　　　Next
　　　　
　　　　'系列をLoop
　　　　For i = 1 To cnt
　　　　　　v = Split(.SeriesCollection(i).Formula, ",")
　　　　　　ub = UBound(v)
　　　　　　'右端の")"を除外
　　　　　　v(ub) = Left$(v(ub), Len(v(ub)) - 1)
　　　　　　'左端の"=SERIES("除外
　　　　　　ret(i, 0) = Mid$(v(0), 9)
　　　　　　n = 1
　　　　　　For j = 1 To cx
　　　　　　　　'隔範囲のアドレスを考慮
　　　　　　　　If Left$(v(n), 1) = "(" Then
　　　　　　　　　　ReDim s(1 To ub) As String
　　　　　　　　　　For k = 1 To ub
　　　　　　　　　　　　s(k) = v(n)
　　　　　　　　　　　　n = n + 1
　　　　　　　　　　　　If Right$(s(k), 1) = ")" Then Exit For
　　　　　　　　　　Next
　　　　　　　　　　ReDim Preserve s(1 To k)
　　　　　　　　　　ret(i, j) = Join(s, ",")
　　　　　　　　Else
　　　　　　　　　　ret(i, j) = v(n)
　　　　　　　　　　n = n + 1
　　　　　　　　End If
　　　　　　Next
　　　　Next
　　End With
　　'書き出しセルは取り敢えず新規シートに。
　　Sheets.Add.Range("A1").Resize(cnt + 1, cx + 1).Value = ret
End Sub

理解するには、VBE[ローカルウィンドウ]表示させて変数の中身を確認しながらステップ実行すると良いでしょう。

この回答へのお礼

回答ありがとうございました。
作動は確認できました。
コードは難しくて直ぐには分かりませんが、
ゆっくりと考えてみます。

お礼日時：2009/10/06 15:19