生徒：先生、このコードは何してるんですか？
先生：このコードは、アクティブなグラフからデータを取り出して、別のシート「Data」にそのデータを転送するものやで。
生徒：グラフからデータを取り出すって、具体的にはどうやってるんですか？
先生：まず、グラフが存在するかチェックして、存在するならそのグラフのX軸とY軸の値を「Data」シートに書き込むんや。
生徒：X軸の値はどうなるんですか？
先生：X軸の値は「Data」シートの1列目に転送されるんや。最初に「X Values」って書かれて、その下にグラフのX軸のデータが並ぶ感じやな。
生徒：Y軸の値はどうやって転送されるんですか？
先生：グラフの各系列（Y軸のデータ）は、カウンターで列をずらしながら「Data」シートに転送されるんや。それぞれの系列名も1行目に書き込まれるんやで。
生徒：グラフがなかったらどうなるんですか？
先生：グラフがなかったら、最後の方で「アクティブなグラフが見つかりません！」って警告が出るようになっとるで。
生徒：なるほど、グラフのデータを自動で取り出すんですね！
Sub グラフデータ抽出()
Dim NumberOfRows As Integer
Dim X As Object
Dim Counter As Integer
' Counter を 2 で初期化
Counter = 2
' アクティブなグラフが存在するか確認
If Not ActiveChart Is Nothing Then
' 最初の系列の値から行数を取得
NumberOfRows = UBound(ActiveChart.SeriesCollection(1).Values)
' "Data" シートにデータを書き込む
With Worksheets("Data")
' X軸の値をヘッダに設定
.Cells(1, 1) = "X Values"
' X軸の値をワークシートに転送
.Range(.Cells(2, 1), .Cells(NumberOfRows + 1, 1)) = Application.Transpose(ActiveChart.SeriesCollection(1).XValues)
' グラフのすべての系列をループして処理
For Each X In ActiveChart.SeriesCollection
' 各系列の名前を1行目に書き込む
.Cells(1, Counter) = X.Name
' 各系列のY軸の値をワークシートに転送
.Range(.Cells(2, Counter), .Cells(NumberOfRows + 1, Counter)) = Application.Transpose(X.Values)
' 次の系列のためにカウンターをインクリメント
Counter = Counter + 1
Next X
End With
Else
' アクティブなグラフが存在しない場合に警告を表示
MsgBox "アクティブなグラフが見つかりません！"
End If
End Sub
