三流君 ken3のmemo置き場

三流プログラマーのメモ書きです。主にVBAやWindowsの話題が多いです

挨拶・自己紹介:
失敗続きのAB型の変わり者 :三流プログラマー Ken3です
フリーのエンジニア・個人事業主です・・と書くと聞こえはイイが(それとなくカッコよく聞こえるが)、 現在は小さな案件の受注請負 と 短期派遣 で 日々つつましく?ほそぼそと暮らしてます。

よく検索されるキーワード: [質問回答XXXXさんへ] [CreateObject] [VBA] [JRA競馬オッズ]

XXXXXさんへ マクロでPowerPointのテキストを取得したい なら

マクロで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

Ken3 ホームページ 目次

分類:HPを大きく分けると4つの柱(分類)です。

  1. [VBA・マクロ プログラミング]の解説
    当店の人気はVBA系のCreateObject("XXXXXX.application")で他のアプリケーションを操作するサンプルが人気です
  2. [プログラマーの愚痴]では、あまり見せたくない三流プログラマーの内面かな。
    三流君を踏み台にする
  3. [古いクラシック ASP(Active Server Pages)]の解説。
  4. [元コンビニ店長時代の話]が弟に巻き込まれ、失敗した脱サラ、畑違い?の仕事で失敗。
主に上記4つの分類でHP作成やメルマガの発行を行ってます。
※更新頻度が落ちていて情報の鮮度が悪いです。



本当に三流なんです(笑):たまにスゴイですねなんて言われることもありますが、
真実は→ [三流君の真実は...] ←を初めに見てくださるとわかると思います。
(からくりは、成功例↑しか載せてなくて ヒドイ失敗例はお蔵入り迷宮入りが多かったりします)