PPTファイルの索引データを作成する

https://github.com/kencoba/PPT2Index

PowerPointファイルの索引データ(キーワードとページ番号リストの対)を
出力するプログラムを作成した。

PPT2Index.bat PowerPointファイル テキストデータ抽出ファイル 索引用キーワードファイル

として実行する。

「テキストデータ抽出ファイル」とは、PowerPointファイル中の
スライド、ノートのテキストデータを抜き出したxmlファイルである。
PPT2Indexが作成する中間ファイルである。

「索引用キーワードファイル」は、単に索引として抜き出したい
キーワードを並べたファイル。
以下のような内容である。

                                            • -

オブジェクト
メッセージ
属性
操作
クラス
インスタンス

                                            • -

出力結果は、上記索引用キーワード、タブ、スライド番号リスト(カンマ区切り)
が並んだ形で出力される。
たとえば以下のようになる

                                            • -

オブジェクト 12,13,18
メッセージ 12,13,24
属性 14,15
操作 15
クラス 25
インスタンス 27

                                            • -

PowerPointのスライドに対し、索引を作成する(1)改

コマンドラインから実行できるようにした。

' > cscript PPT2Text.vbs powerpoint-filename 
Option Explicit

' ファイル名を実行時パラメータから取得する
Dim pptFilename
pptFilename = WScript.Arguments.Item(0)

Dim oApp
Set oApp = CreateObject("PowerPoint.Application")
oApp.Visible = True

oApp.Presentations.Open(pptFilename)

WScript.echo "<?xml version='1.0' encoding='Shift_JIS' ?>" & vbCrLf
WScript.echo "<Slides>" & vbCrLf

' 全スライドに対して処理を行う
Dim pSlide
For Each pSlide In oApp.ActiveWindow.Parent.Slides
        WScript.echo "<Slide><SlideNumber value='" & pSlide.SlideNumber & "'/>" & vbCrLf
        WScript.echo "<SlideBody><![CDATA[" & vbCrLf
        
        ' スライドのテキストを全部表示する
        Dim pShape
        For Each pShape In pSlide.Shapes
                If pShape.HasTextFrame Then
                        If pShape.TextFrame.HasText Then
                                With pShape.TextFrame.TextRange
                                        WScript.echo CleanChar(.Text)
                                End With
                        End If
                End If
        Next
        
        ' ノートのテキストを全部表示する
        For Each pShape In pSlide.NotesPage.Shapes
                If pShape.HasTextFrame Then
                        If pShape.TextFrame.HasText Then
                                With pShape.TextFrame.TextRange
                                        WScript.echo CleanChar(.Text)
                                End With
                        End If
                End If
        Next
        
        WScript.echo "]]></SlideBody>" & vbCrLf
        WScript.echo "</Slide>" & vbCrLf
Next

WScript.echo "</Slides>"

oApp.ActivePresentation.Application.Quit ' PowerPointを終了する

Set oApp = Nothing


' http://www.tsware.jp/tips/tips_406.htm
' 上記サイトから引用
Private Function CleanChar(ByVal strData)
'引数の文字列から制御コードを除去した文字列を返す

  Dim strRet
  Dim strCurChar
  Dim iintLoop

  strRet = ""
  For iintLoop = 1 To Len(strData)
    strCurChar = Mid(strData, iintLoop, 1)
    If Asc(strCurChar) < 0 Or Asc(strCurChar) >= 32 Then
      '漢字のAscの返り値はマイナスに留意
      strRet = strRet & strCurChar
    End If
  Next

  CleanChar = strRet

End Function