【ExcelVBA】Excelからパワポを制御するには

Yahoo!知恵袋の質問に答えた中から、ExcelからPowerPintを制御するにはどうするかを紹介します。

質問

https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q11272043366

あるフォルダ内に、パワポファイルが複数保管されており、vbsかエクセルのマクロなどでリスト管理したいのです。
やりたいことが形にできなくて困っています。。。
各パワポのファイル名からの切り取りと、パワポ内のテキストをエクセルリストに貼り付けることはできますか？

パワポのファイル名には規則があります。
例) results-001-タイプAとタイプBを比較.pptx
このパワポファイルのP.1に簡潔に結果がかかれたテキストあり
［結果］タイプBの方が小さい

エクセルシートの列に、ナンバー、標題、内容と並べたいのです。
例) 001 タイプAとタイプBを比較 タイプBの方が小さい

https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q11272043366

回答

質問文の中にVBSかエクセルのマクロとありましたので、ExcelのVBAで回答しました。

Option Explicit

Public Sub PowerPoint_ListUp()
    'パワポファイルをリストアップ
    Dim pp As Object
    Dim stPath As String
    Dim stPp As String
    Dim vBuf As Variant
    Dim sh As Worksheet
    Dim vOut() As Variant
    Dim lCnt As Long
    
    stPath = "C:\test\"
    Set sh = ThisWorkbook.Worksheets(1)
    Set pp = CreateObject("PowerPoint.Application")
    
    stPp = Dir(stPath & "*.pptx") '---①
    lCnt = 0
    Do While stPp <> ""
        vBuf = Split(stPp, "-") 'ハイフン「-」で分割する---②
        ReDim Preserve vOut(1 To 3, 0 To lCnt) '---③
        vOut(1, lCnt) = "'" & vBuf(1)   'ゼロで始まる数字を文字列と認識してもらうために’つける
        vOut(2, lCnt) = Replace(vBuf(2), ".pptx", "")
        vOut(3, lCnt) = GetText(pp, stPath & stPp)
        
        stPp = Dir() '---④
        lCnt = lCnt + 1
    Loop
    
    sh.Cells(2, 2).Resize(lCnt, 3).Value = WorksheetFunction.Transpose(vOut)   '---⑤配列vOutの行と列とを入れ替えて(Transpose)ワークシートに一度に書き込む
    sh.Cells(1, 2).Resize(1, 3).Value = Array("ナンバー", "標題", "内容") '---⑥
    pp.Quit
    Set pp = Nothing
    Set sh = Nothing
End Sub

Private Function GetText(ByRef pp As Object, ByVal stFullPath As String) As String
    Dim Obj As Object
    Dim oShape As Object
    
    Set Obj = pp.Presentations.Open(stFullPath) '---⑦
    For Each oShape In Obj.Slides(1).Shapes '---⑧
        If oShape.HasTextFrame Then '---⑨
            '一番最初にテキストフレームが見つかったら、そこでループを抜けるようにしてあります
            '質問者様のパワポの仕様がよく分からないので、この辺は実際のパワポの仕様にあわせて
            '変えてください
            GetText = Replace(oShape.TextFrame.TextRange.Text, "［結果］", "") '---⑩
            Exit For
        End If
    Next oShape
    
    Obj.Close
    Set Obj = Nothing
End Function

解説

①の解説

①Dir(stPath & “*.pptx”)で指定されたフォルダの中をワイルドカードを使って検索しています。

今回テスト用に次のような環境を用意しておきました。

②～④の解説

②Splitは文字列を指定した文字で分割してくれます。今回は「results-001-タイプAとタイプBを比較.pptx」という文字列を「-」(ハイフン)で分割しますので、次のようになります。

• vBuf(0)・・・results
• vBuf(1)・・・001
• vBuf(2)・・・タイプAとタイプBを比較.pptx

このうち、最初のresultsはいらないので、処理の中では使っていません。

③出力用に一時的に用意したvOutというVariant型変数を、Preserve付で再定義しています。

本当なら、(行、列)の順番で定義したいところですが、VBAではReDimできるのは、最後尾の要素と決まっているのでした。今回、列要素は3個までと決まっており、行要素を拡大していきたいので、やむなく(列、行)の順番で再定義しています。

④Dir()でもう一度同じフォルダ内を検索しています。

⑤、⑥の解説

⑤配列vOutをそのままワークシートに書き出すと行と列が逆になっていますので、ワークシート関数のTransposeを使って、行と列とを入れ替えて書き出しています。

⑥分かりやすいように見出しをつけました。Arrayというのは配列要素を一つ一つ指定して設定することができる関数です。

⑦、⑧の解説

⑦ExcelからPowerPointを開くときは、こんな風に書きます。Excelでブックを開くとき、Workbooks.Openと書くのですが、これは、正確にはApplilcation.Workbooks.Openと書きます。

ブックを開くとき・・・Application.Workbooks.Open(引数)

PowerPointを開くとき・・・pp.Presentations.Open(引数)

ppというのは、PowerPoint.Applicationのオブジェクトです。Excelもパワポも、よく似ていると思うのですが、どうでしょうか・・・？

⑧パワーポイントの中のスライドはこんな風に書きます。これもExcelのシートとよく似ていると思います。

シート上のShapesを使いたいとき・・・ThisWorkbook.Worksheets(1).Shapes

パワポのスライド上のShapesを使いたとき・・・Obj.Slides(1).Shapes

Objというのは、今回はPresentation用に用意したオブジェクト変数です。

私は参照設定をしないで使うことが多いので、Dim Obj As Objectと定義することが多いのですが、ちゃんと参照設定して使う場合には、Dim Obj As Presentionと定義します。

⑨、⑩の解説

⑨Shapeに文字列を扱うテキストフレームが存在したらという意味です。

今回、肝心のパワポの仕様がよく分かりませんでした。最初のスライドに存在することは分かっているのですが、その最初のスライドにいくつShapeが存在し、その何番目にTextFrameが存在するのか、また、そのTextFrameの中の文字列には必ず「［結果］」が先頭にあるのか等、質問文からは読み取れなかったので、この辺は多分修正が必要になるでしょう。

⑩Shapeにある文字列をとってくるときはこんな風に書きます。

oShape.TextFrame.TextRange.Text

長いですよね。初めてこれを知ったときは、「なんて長いんだ！？正気か！？」と驚きました。ほしい情報にたどりつくまでに、4つも階層を深くもぐっていかないといけないというのは・・・・でも今ではすっかり慣れました。

質問文から、「［結果］」の部分は取り除くように読み取れましたので、Replaceで取り除いています。

実行結果

私の環境でテストしてみた結果はこんな感じです。

注意

デバッグしていたら、なんどかObj.Closeのところで中断しました。

PowerPointを閉じようとして失敗しているようです。

VBEの画面で実行を押すと、無事閉じることができましたが、原因は不明です。