Excelに表をエクスポートするPowerPointマクロ

たくさんの表の含まれているPowerPointのプレゼンテーションファイルを元に、Excelで資料を作成しようとしている方から、
「PowerPoint上の表をExcelにエクスポートすることはできないのでしょうか？」
といったご質問をいただくことがあります。

PowerPoint上の表の数が少なければ、コピペを頑張るのでしょうが、表の数が2桁になってくると、さすがにイヤになる人が増えます。

PowerPointには、Wordへ出力する機能は存在していますが、残念ながらExcelへの出力機能はありません。

で、VBA（Visual Basic for Applications）でマクロを作ってみました。

すべての表をExcelに出力するサンプルマクロ

こういったアプリケーションの連携をするようなマクロは、細かな要望がいろいろと出てくるのですが、もっとも基本的なマクロをご紹介しておきます。

上記のマクロを実行すると、新規のExcelブックに、アクティブなプレゼンテーションファイル上の表がすべて出力されます。

サンプルマクロの解説

まず、ExcelをCreateObjectして、
　Set xl_app = CreateObject("Excel.Application")

Excelを表示し、
　xl_app.Visible = True

新規ブックを作成します。
　Set xl_wbk = xl_app.Workbooks.Add

表の出力先を指定する変数を初期化し、
　xl_row = 1

アクティブなプレゼンテーションファイルの、全Slideにループを回し、
　For Each sld In ActivePresentation.Slides

個々のスライド内の全Shapeにループを回し、
　For Each shp In sld.Shapes

Shape内に表が存在していたなら、
　　If shp.HasTable Then

表の、
　　With shp.Table

すべての行にループを回し、
　　　For r = 1 To .Rows.Count

行方向のループの中で、すべての列にループを回して、
　　　　For c = 1 To .Columns.Count

先に作成しておいた、新規のExcelブックの1枚目のワークシートに、
　　　　　xl_wbk.Worksheets(1).Cells(xl_row, c).Value = _

PowerPointの表のセルの文字列を出力していきます。
　　　　　　.Cell(r, c).Shape.TextFrame.TextRange

列のループが終わったところで、出力先行番号を格納する変数・xl_rowをインクリメントし、
　　　　Next c
　　　　xl_row = xl_row + 1

表と表の間には空白行を入れておきたいので、一つの表の行方向のループが全部終わったところでも、xl_rowをインクリメントしています。
　　　Next r
　　　xl_row = xl_row + 1

決して複雑なことをしているわけではありませんが、PowerPointでは、Shapeの中にTableがあって、Tableの個々のCellにまたShapeが存在している、という階層の深さがポイントです。