AIで動画からコードをまとめる元データ紛失…パワポのグラフから数値を1秒で抜き出すVBAマクロ【リンク切れ救済】

元データ紛失…パワポのグラフから数値を1秒で抜き出すVBAマクロ【リンク切れ救済】

「リンクされたファイルが見つかりません」

PowerPointでグラフを編集しようとした瞬間、この無慈悲なエラーメッセージに血の気が引いた経験はありませんか？
元データのExcelファイルを削除してしまったり、サーバー移行でパスが変わってしまったり…。

残されたのは、画像として張り付いたグラフだけ。
「まさか、目視でグラフの数字を拾ってExcelに入力し直し…？」

''諦めないでください。その「単純作業」、VBAで自動化できます。''

今回は、リンク切れで編集不能になったPowerPointのグラフから、内部に残っている数値データを吸い出してExcelに復元する救済マクロを紹介します。

【結論】コピペで使える救済用VBAコード

四の五の言わずに、まずは解決策です。
以下のコードをPowerPointのVBA標準モジュールに貼り付けて実行してください。
選択しているスライド内のグラフを探し、データを新しいExcelブックに書き出します。

Sub パワポのグラフ数値をExcelへ復元()
    ' 選択中のスライドにあるグラフから数値をExcelへ書き出すマクロ
    ' 作成: Ken3 (https://www.youtube.com/@ken3video)
    
    Dim objSlide As Slide
    Dim objShape As Shape
    Dim ppChart As Chart
    Dim ppSeries As Series
    Dim x As Long, y As Long
    
    ' Excelアプリケーションの起動（書き出し先）
    Dim oApp As Object
    Dim oBook As Object
    Dim oSheet As Object
    
    On Error Resume Next
    Set oApp = GetObject(, "Excel.Application")
    If oApp Is Nothing Then
        Set oApp = CreateObject("Excel.Application")
    End If
    oApp.Visible = True
    Set oBook = oApp.Workbooks.Add
    Set oSheet = oBook.Sheets(1)
    On Error GoTo 0
    
    ' Excelの見出し作成
    oSheet.Range("A1").Value = "Slide_ID"
    oSheet.Range("B1").Value = "Graph_Name"
    oSheet.Range("C1").Value = "Series_Name"
    oSheet.Range("D1").Value = "Data_Values..."
    
    Dim rBASE As Object
    Set rBASE = oSheet.Range("A2") '書き出し開始位置
    y = 0
    
    ' 現在選択しているスライドを処理対象にする
    If ActiveWindow.Selection.Type <> ppSelectionSlides Then
        MsgBox "スライド一覧から対象のスライドを選択して実行してください"
        Exit Sub
    End If
    
    ' 選択スライド内のシェイプを探索
    For Each objSlide In ActiveWindow.Selection.SlideRange
        For Each objShape In objSlide.Shapes
            ' グラフ(Chart)を持っているか判定
            If objShape.HasChart Then
                Set ppChart = objShape.Chart
                
                ' 各系列(Series)のデータを取得
                For Each ppSeries In ppChart.SeriesCollection
                    ' スライドID, グラフ名, 系列名を書き出し
                    rBASE.Offset(y, 0).Value = objSlide.SlideID
                    rBASE.Offset(y, 1).Value = objShape.Name
                    rBASE.Offset(y, 2).Value = ppSeries.Name
                    
                    ' 数値データ(Values)の書き出し
                    Dim vData As Variant
                    vData = ppSeries.Values
                    
                    If IsArray(vData) Then
                        For x = LBound(vData) To UBound(vData)
                            ' Excelへ転記 (+3列目からデータ)
                            rBASE.Offset(y, 2 + x).Value = vData(x)
                        Next x
                    End If
                    
                    y = y + 1 '次の行へ
                Next ppSeries
            End If
        Next objShape
    Next objSlide
    
    MsgBox "Excelへの抽出が完了しました！"
End Sub

【動画で確認】使い方の手順と実行デモ

コードを貼ったけれど、どうやって動かすの？本当にデータが抜けるの？
と不安な方は、実際の操作画面をご覧ください。

「論より証拠」、エラーが出ているグラフから数値がExcelに転記される瞬間です。

''▼ [01:19](https://www.youtube.com/watch?v=RD5ovhJncsY&t=79s) マクロ一発でExcelへデータ復元される瞬間を見る''

使い方の3ステップ

1. PowerPointで `Alt + F11` を押してVBEを開く。
2. `挿入` -> `標準モジュール` に上記コードを貼り付ける。
※貼り付け方が不安な方は動画の解説へどうぞ：''[08:40](https://www.youtube.com/watch?v=RD5ovhJncsY&t=520s) コードの貼り付け方・実行方法''
3. スライド一覧で対象のスライドを選択し、マクロを実行する。

コードの仕組み解説：なぜリンク切れでもデータが抜けるのか？

「元データがないのに、なぜ数値がわかるの？」と不思議に思うかもしれません。
実は、PowerPointのグラフオブジェクト（`Chart`）は、表示用に内部で数値を保持しているのです。

このマクロでは、その隠れたデータにアクセスしています。

1. グラフかどうかを判定する

If objShape.HasChart Then
    Set ppChart = objShape.Chart

まず、スライド上の図形が「グラフ（Chart）」を持っているか `HasChart` プロパティで確認します。
ここの判定ロジックについては、動画で詳しくデバッグしながら解説しています。
''▼ [14:35](https://www.youtube.com/watch?v=RD5ovhJncsY&t=875s) Shape.HasChart：それがグラフか判断する''

2. 系列（Series）と数値（Values）を取得する

ここがこのマクロの心臓部です。

For Each ppSeries In ppChart.SeriesCollection
    ' ...
    vData = ppSeries.Values  ' 数値データの配列
    ' ...
Next

`SeriesCollection` というコレクションの中に、グラフの各系列（棒グラフの青い棒、オレンジの棒など）が入っています。
そして、`ppSeries.Values` に数値が、`ppSeries.XValues` に項目名（横軸のラベル）が入っています。

ここを理解すると、応用して「特定のデータだけ抜き出す」ことも可能になります。
''▼ [16:04](https://www.youtube.com/watch?v=RD5ovhJncsY&t=964s) SeriesCollection（系列）の取得について''
''▼ [17:51](https://www.youtube.com/watch?v=RD5ovhJncsY&t=1071s) XValues（項目名）とValues（数値）の書き出し''

【注意】抽出できないパターン（埋め込みオブジェクト）

万能に見えるこのマクロですが、弱点があります。
それは「Excelワークシートオブジェクト」として埋め込まれている場合など、`Chart` オブジェクトとして認識されないパターンです。

「実行したけど何も起きない…」という場合は、対象のグラフが特殊な形式である可能性があります。
動画内で、抽出できないケースの検証と、その見分け方（`Shape.Type`プロパティの確認）を行っています。

''▼ [32:16](https://www.youtube.com/watch?v=RD5ovhJncsY&t=1936s) 抽出できないパターン（埋め込みオブジェクト等）''
''▼ [36:20](https://www.youtube.com/watch?v=RD5ovhJncsY&t=2180s) なぜ抜けない？「リンク貼り付け」と「埋め込み」の違い''