マクロでPowerPointのテキストを取得したい なら
昔書いた記事の
ken3memo.hatenablog.com
が使えれば。
※↑テキストボックスや図形に付いた文字列だけで、
表などは取得してないけど、参考になれば幸いです。
リンク先のコードを転記します。
Option Explicit '起動済みの既存 パワーポイント スライド .Shapes から テキストを取り出す 'アクティブシートに名前とテキストをセット ※勝手に全クリアして書き込むので※※注意 Sub test20220328スライド内テキストを取得() Dim ppApp As PowerPoint.Application On Error Resume Next '取得エラー時に次へ Set ppApp = GetObject(, "PowerPoint.Application") On Error GoTo 0 'エラーを元に戻す※これを忘れると、デバッグ時にハマるから注意 If ppApp Is Nothing Then MsgBox "パワポを取得できません。プレゼンスライドを開いてから、再テストしてね" Exit Sub End If 'Sheets.Add After:=ActiveSheet 'シートを新規で追加するのもアリ?お任せします Cells.ClearContents 'アクティブシートを※勝手に全クリアして書き込むので※※注意 Range("A1").Select '見出しを書き込む Range("A1") = "Page番号" Range("B1") = "名前 Shape.Name" Range("C1") = "テキスト objShape.TextFrame.TextRange.Text" Dim p As Integer, y As Integer 'pページ、y行 Dim objShape As PowerPoint.Shape 'パワポのシェイプ、テキスト、図形ほか y = 2 '取得したテキストデータを二行目から書きたいので For p = 1 To ppApp.ActivePresentation.Slides.Count 'スライド数ループ pページ 'pページのスライド内のシェイプを探る For Each objShape In ppApp.ActivePresentation.Slides(p).Shapes Cells(y, "A") = p 'スライド番号(ページ番号) Cells(y, "B") = objShape.Name 'オブジェクトの名前 'オブジェクトがテキストを持っているか?チェックしてからセット If objShape.HasTextFrame = msoTrue Then 'テキストフレームあり If objShape.TextFrame.HasText = msoTrue Then 'テキスト範囲あり Cells(y, "C") = objShape.TextFrame.TextRange.Text 'C列へテキスト End If End If y = y + 1 'セットする行を次へ Next Next '最後に列幅の自動調整 と思ったら、C列は文字数が多くてやらないほうがよかった Columns("A:B").EntireColumn.AutoFit '名前のB列だけやったほうがいいかも Columns("C:C").ColumnWidth = 24 'AutoFitでひどい目にあったのでテキストは固定24 MsgBox "処理終了" End Sub
余談、宣伝?:
表の取得は、こっちが参考になれば、
ken3memo.hatenablog.com