Shape.OLEFormat.Objectを活用！PowerPoint内の埋め込みExcelを自動抽出・保存するVBA解説

【パワポVBA】埋め込みExcelを一括保存！OLEオブジェクトを吸い出す方法

パワーポイントの資料の中に埋め込まれたExcelデータ、これを取り出すのって意外と面倒ですよね。「拡張子を .zip に変えて解凍すれば中身が見える」という裏技もありますが、一部の表が ''oleObject.bin'' という謎のファイルになってしまい、手が出せなくなることも…。

AIを使い、過去動画を備忘録にまとめてもらった

今回は、そんな「吸い出せないOLEオブジェクト」をVBAを使って自動でファイル保存する実験の備忘録です。三流プログラマーの私が試行錯誤した軌跡（と恥ずかしいバグ）をまとめました。

解決したい悩み

• パワポ内の埋め込みExcelを一つずつ開いて保存するのが面倒
• zip解凍しても .bin ファイルになってしまい、Excelとして開けない
• 大量のスライドからExcelデータだけを一括抽出したい

メインのソースコード（Excelから実行）

紆余曲折ありましたが、一番安定したのは「Excel側からPowerPointを操作し、内容を新しいブックにコピーする」方法でした。

'Excelから開かれている既存のPowerPointを捕まえて
'埋め込まれている OLEオブジェクトのExcelシートを吸い上げる
Sub ExcelからPP内のOLE型にアクセスして別名保存する()
    Dim ppApp As Object
    Set ppApp = Nothing
    On Error Resume Next
    Set ppApp = GetObject(, "PowerPoint.Application")
    On Error GoTo 0

    If ppApp Is Nothing Then
        MsgBox "OLEが埋まっているパワポを開いてから実行してください"
        Exit Sub
    End If

    Dim p As Integer
    Dim ppSlide As Object, ppShape As Object
    
    '全スライドをループ
    For p = 1 To ppApp.ActivePresentation.Slides.Count
        Set ppSlide = ppApp.ActivePresentation.Slides(p)
        
        'スライド内の全シェイプをループ
        For Each ppShape In ppSlide.Shapes
            'OLE埋め込みオブジェクト（Type=7）かチェック
            If ppShape.Type = 7 Then 
                '中身がWorkbook形式か確認
                If TypeName(ppShape.OLEFormat.Object) = "Workbook" Then
                    Dim ppOLEwb As Excel.Workbook
                    Set ppOLEwb = ppShape.OLEFormat.Object
            
                    '保存用の新しいBookを作成
                    Dim newWB As Workbook
                    Set newWB = Application.Workbooks.Add
                    
                    '中身をコピーして貼り付け
                    ppOLEwb.Sheets(1).Cells.Copy
                    newWB.Sheets(1).Paste
                    
                    '名前を付けて保存（実行ファイルと同じフォルダ）
                    Dim strFileName As String
                    strFileName = ThisWorkbook.Path & "\埋め込みExcel_Page" & p & ".xlsx"
                    
                    Application.DisplayAlerts = False
                    newWB.SaveAs strFileName
                    newWB.Close
                    Application.DisplayAlerts = True
                    
                    Set newWB = Nothing
                    Set ppOLEwb = Nothing
                End If
            End If
        Next
    Next p
    MsgBox "抽出が完了しました！"
End Sub

手順とポイントの解説

動画では、以下の流れで試行錯誤しています。

1. オブジェクトの正体を探る [01:55](https://www.youtube.com/watch?v=-GFfMCoBXAQ&t=115s)

パワポの「挿入」→「オブジェクト」から埋め込まれたExcelは、VBAからは ''Shape'' オブジェクトとして見えます。その ''OLEFormat.ProgID'' を確認すると、''Excel.Sheet.12''（xlsx形式）や ''Excel.Sheet.8''（xls形式）といった正体がわかります。

2. ウォッチ式で構造を解析 [02:29](https://www.youtube.com/watch?v=-GFfMCoBXAQ&t=149s)

最初は `SaveAs` メソッドで直接保存しようとしましたが、なぜか空のファイルが保存される現象が発生。そこで、ウォッチ式を使って `objShape.OLEFormat.Object` が本当に `Workbook` として機能しているか、イミディエイトウィンドウで `Sheets(1).Name` などを叩いて確認しました。 [06:14](https://www.youtube.com/watch?v=-GFfMCoBXAQ&t=374s)

3. Excel側から攻める「別コース」の採用 [11:00](https://www.youtube.com/watch?v=-GFfMCoBXAQ&t=660s)

パワポ側からの直接保存が不安定だったため、Excelからパワポをコントロールする手法に切り替えました。埋め込みオブジェクトを Workbook として変数にセットし、その中身（Cells）を丸ごと新しいExcelブックにコピー＆ペーストする力技です。

4. 恥ずかしいバグの教訓 [18:48](https://www.youtube.com/watch?v=-GFfMCoBXAQ&t=1128s)

開発中、ファイル保存でエラーが出ましたが、原因は `ActiveWorkbook.Path` を使っていたことでした。新規作成したばかりのブックは保存場所が決まっていないのでパスが空なんですね。`ThisWorkbook.Path`（マクロを書いているファイル自身のパス）を使うのが正解でした。

今後の課題とアドバイス

今回のコードにはまだ改善の余地があります。

• ''複数シートへの対応'': 現状では `Sheets(1)` しかコピーしていません。埋め込みデータに複数シートある場合は、ループ処理が必要です。
• ''書式の維持'': `Cells.Copy` だと列幅などの書式が完全に再現されない場合があります。

もし、どうしても .bin ファイルから逃れられない場合は、このVBAで「Excelのインターフェースを通して中身をコピーする」方法を試してみてください。

関連リンク

• YouTube動画本編はこちら
• Microsoft公式：Workbook.SaveAs メソッド
• キッカケとなった知恵袋の質問

この記事が皆さんの自動化のヒントになれば幸いです！