【パワポ検索ツールを作る7】表判定


コード

 前回はテキストフレームを待っていないグループ化されたシェイプ内の文字を検索する方法を紹介しました(前回の記事)。今回は表の中の文字を検索する方法を記載します。アルゴリズムは前回のグループ化検索と同じで表かどうかを判定します。以下にコードを掲載します。

'VBA標準モジュール
Option Explicit

Sub findTest(txt As String)
    Dim prs As Presentation  'プレゼンテーション
    Dim sld As Slide    'スライド
    Dim shp As Shape    'シェイプ
    Dim gshp As Shape    'グループシェイプ
    Dim txtRng As TextRange  'テキストレンジ
    Dim foundtext As TextRange  '文字発見用テキストレンジ
    Dim flgFind As Boolean    '文字発見フラグ
    Dim sldNum As Integer    '文字発見字のスライドNo
    Dim msg As String    'メッセージ内容
    Dim btm As Integer    'ボタン種類
    Dim ttl As String    'タイトル
    Dim response As Integer    'ボタン押した後の反応
    Dim row As Integer    '表行数用
    Dim col As Integer    '表桁数用
    
    msg = "見つけたよ!!"
    btm = 4
    ttl = "メッセージ"
    flgFind = False

    For Each prs In Presentations  '全プレゼンテーションをループ
        For Each sld In prs.Slides  '全スライドをループ
            For Each shp In sld.Shapes  '全図形をループ
                If shp.HasTextFrame Then    'テキストフレーム有り
                    Set txtRng = shp.TextFrame.TextRange
                    Set foundtext = txtRng.Find(txt, msoFalse, msoFalse)
                    
                    '文字を発見した時
                    If Not (foundtext Is Nothing) Then
                        flgFind = True    '文字発見
                        With foundtext
                            sldNum = sld.SlideIndex  '検索ワードが記載されたスライドNo代入
                            prs.Windows(1).Activate  '検索ワードがあるプレゼンテーションをアクティブ化
                            ActiveWindow.View.GotoSlide Index:=sldNum    '検索ワードがあるスライドを開く
                            response = MsgBox(msg, btm, ttl)  'メッセージの返答に対する返り値
                            
                            'ボタンを押した後の反応
                            If response = vbYes Then    'YESの場合
                                shp.Select  '検索ワードを含むシェイプを選択
                                Exit Sub    'FindTestから抜ける
                            End If
                        End With
                    End If
                Else
                    If shp.Type = msoGroup Then    'グループを見つけた場合
                        For Each gshp In shp.GroupItems
                            If gshp.HasTextFrame Then    'テキストフレーム有り
                                Set txtRng = gshp.TextFrame.TextRange
                                Set foundtext = txtRng.Find(FindWhat:=txt, MatchCase:=msoFalse, WholeWords:=msoFalse)    '  文字発見字のスライドを開く
                                
                                '文字を発見した時
                                If Not (foundtext Is Nothing) Then
                                    flgFind = True    '文字発見
                                    With foundtext
                                        sldNum = sld.SlideIndex
                                        prs.Windows(1).Activate
                                        ActiveWindow.View.GotoSlide Index:=sldNum    '編集中専用
                                        response = MsgBox(msg, btm, ttl)
                                        
                                        'ボタンを押した後の反応
                                        If response = vbYes Then    'YESの場合
                                            shp.Select
                                            Exit Sub    'リターン
                                        End If
                                    End With
                                End If
                            End If
                        Next
                    ElseIf shp.Type = msoTable Then    '表を見つけた場合
                        With shp.Table
                            For row = 1 To .Rows.Count
                                For col = 1 To .Columns.Count
                                    Set txtRng = .Cell(row, col).Shape.TextFrame.TextRange
                                    Set foundtext = txtRng.Find(FindWhat:=txt, MatchCase:=msoFalse, WholeWords:=msoFalse)    '  文字発見字のスライドを開く
                                    
                                     '文字を発見した時
                                    If Not (foundtext Is Nothing) Then
                                        flgFind = True    '文字発見
                                        With foundtext
                                            sldNum = sld.SlideIndex
                                            prs.Windows(1).Activate
                                            ActiveWindow.View.GotoSlide Index:=sldNum    '編集中専用
                                            ActiveWindow.View.GotoSlide Index:=sldNum    '編集中専用
                                            response = MsgBox(msg, btm, ttl)
                                            
                                            'ボタンを押した後の反応
                                            If response = vbYes Then    'YESの場合
                                                shp.Table.Cell(row, col).Shape.Select
                                                Exit Sub    'リターン
                                            End If
                                        End With
                                    End If
                                Next col
                            Next row
                        End With
                    End If
                End If
            Next
        Next
    Next
    
    If flgFind = False Then
        MsgBox ("ごめんなさい、見つけられませんでした・・・")
    Else
        MsgBox ("検索終了")
    End If
End Sub

 グループ化判定同様シェイプのshp.Typeの値を見てmsoTableの場合に表と判定します。以下資料の様に適当な表を用意し、先程書いたコードを実行してみましょう。

動作確認

 表の中の文字で検索をかけると「見つけたよ」と表示されたと思います。これで検索ツールのコードは完成です。次回はこの検索ツールをGUIみたいなアプリとして立ち上げるアドインのやり方を紹介します。


コメントを残す