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

アクティブなプレゼンテーションファイル上のすべての表をExcelにエクスポートするPowerPointマクロをご紹介しました。

似たようなニーズですが、PowerPoint上の表をWordにエクスポートしたい、という要望をいただくこともあります。

Wordに表をエクスポートするサンプルマクロ

Wordにエクスポートする場合は、以下のようなマクロです。

上記のマクロを実行すると、新規Word文書に、アクティブなプレゼンテーションファイル上の表がすべてエクスポートされます。

サンプルマクロの解説

やっていることは以下のとおりです。

まず、WordをCreateObjectして、
　Set wd_app = CreateObject("Word.Application")

Wordを表示して、
　wd_app.Visible = True

新規文書を作成します。
　Set wd_doc = wd_app.Documents.Add

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

各スライドで全Shapeにループを回し、
　For Each shp In sld.Shapes

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

そのTabelをオブジェクト変数・tblに格納しておいてから、
　　　Set tbl = shp.Table

Word文書に同じサイズの表を挿入します。
　　　Set wd_tbl = wd_doc.Tables.Add( _
　　　　　Range:=wd_doc.Bookmarks("\EndOfDoc").Range, _
　　　　　NumRows:=tbl.Rows.Count, _
　　　　　NumColumns:=tbl.Columns.Count)

Word文書の末尾に追加したいので、WordのTables.Addメソッドの引数・Rangeにwd_doc.Bookmarks("\EndOfDoc").Rangeを指定し、NumRowsとNumColumnsにPowerPointの表の行数と列数を指定しています。

Wordに作成した表に罫線があったほうが見やすいでしょうから、スタイル「表 (格子)」を設定しています。
　　　wd_tbl.Style = "表 (格子)"

PowerPoint上の表の行方向にループを開始し、
　　　For r = 1 To tbl.Rows.Count

行方向のループの中で、列方向のループを開始して、
　　　　For c = 1 To tbl.Columns.Count

Wordの表に、PowerPointの表のデータを出力しています。
　　　　　wd_tbl.Cell(r, c).Range.InsertAfter _
　　　　　　tbl.Cell(r, c).Shape.TextFrame.TextRange

別の表がくっついてしまうとイヤなので、一つの表の出力が終わるごとに、Word文書の最後に改行コードを挿入しています。
　　　　Next c
　　　Next r
　　　wd_doc. _
　　　　Bookmarks("\EndOfDoc").Range.InsertAfter vbCrLf