VBA Excelで指定した文字をWord文章中から探す段落オブジェクト Paragraph を使用 Range.Informationで位置を取得 #VBA #Word #デバッグ #Excel

ExcelからWordの段落オブジェクトParagraphsを使用して検索文字列の位置Range.Informationを探してみました
※人力検索から浮気して teratail の質問に回答してみた。いつもの人力検索のノリなので、常連さんに怒られないか心配しつつ・・・

浮気先(質問元)
teratail.com
他の回答やコメントも参考にしてください。

実現したいこと:
エクセルの＜検索文字列＞シートのA列に列挙されている検索文字列群（A1からA2、A3、、、に検索したい文字が入力されています）がwordファイルの文章中に使われているかそれぞれ検索し、出現ページ・行を＜結果＞シートに出力したい。

いつもの酔っ払い動画、、、
youtu.be
https://youtu.be/dSlL0aNsI28
↑実行結果の動画と簡単な解説です、気になった人は、YouTube動画を確認してみてください
00:00 作りたい内容詳細を説明実行結果
03:50 1.wdApp.ActiveDocument.Paragraphs(n).Range.Text で段落の文章がとれます
05:43 2.Selection.Range.Information で選択位置の情報が取得できます
06:50 3.段落と行数は違うので、選択位置を移動する

1.wdApp.ActiveDocument.Paragraphs(n).Range.Text で段落の文章がとれます
wdApp.ActiveDocument.Paragraphs(n).Range.Text
段落の文字列が取得できるので、
ループで回してチェックする
'アクティブ文書の段落を頭からなめる ActiveDocument.Paragraphs
For n = 1 To wdApp.ActiveDocument.Paragraphs.Count
str段落文字列 = wdApp.ActiveDocument.Paragraphs(n).Range.Text
'単純にInstrで探してみた
n先頭位置 = InStr(1, str段落文字列, wd) '初回は一文字目から探す

2.Selection.Range.Information で選択位置の情報が取得できます
p = wdApp.Selection.Range.Information(wdActiveEndPageNumber) 'ページ
l = wdApp.Selection.Range.Information(wdFirstCharacterLineNumber) '行
で選択位置のページ番号と行が取得できます

3.段落と行数は違うので、選択位置を移動する
wdApp.ActiveDocument.Paragraphs(n).Range.Select '見つけたので段落選択する
'↑段落全体が選択されているので、↓選択範囲、start位置を移動
wdApp.Selection.MoveStart Unit:=wdCharacter, Count:=n先頭位置 – 1
小細工だけど、段落全体を選択後、選択範囲を移動させ※頭出しをして正しいラインを選択するようにした

ソースコード

'ExcelからWordを操作テスト
Sub test20220121WORD検索テスト2()

    Dim wdApp As Word.Application
    Set wdApp = GetObject(, "Word.Application")

    If wdApp Is Nothing Then
        MsgBox "テスト用のWORD文章を開いてから、再テストしてね"
        Exit Sub
    End If

    Dim i As Integer
    Dim iRow As Integer
    
    Dim maxRow As Integer
    Dim wd As String
    Dim p As Integer, l As Integer   'ページ、行
    
    Dim n As Integer '段落のカウンターで使用
    Dim str段落文字列 As String
    Dim n先頭位置 As Integer
    
    maxRow = 3 '最終行を代入してね テストで3個固定なので、修正してね
    iRow = 1   '結果一行目から、あっ、実行時に結果のシート消さなきゃ↓・・・
    ThisWorkbook.Worksheets("結果").Range("A:A").Clear  'A列をクリア

    For i = 1 To maxRow
        wd = ThisWorkbook.Worksheets("検索文字列").Range("A" & i + 1).Value  '検索文字列
        
        'アクティブ文書の段落を頭からなめる ActiveDocument.Paragraphs
        For n = 1 To wdApp.ActiveDocument.Paragraphs.Count
            str段落文字列 = wdApp.ActiveDocument.Paragraphs(n).Range.Text
            '単純にInstrで探してみた
            n先頭位置 = InStr(1, str段落文字列, wd) '初回は一文字目から探す
            While n先頭位置 <> 0 '検索位置が見つかっている間 0以外の時ループ
                If n先頭位置 > 0 Then '↑で文字が見つかったら、
                    wdApp.ActiveDocument.Paragraphs(n).Range.Select   '見つけたので段落選択する
                    '↑段落全体が選択されているので、↓選択範囲、start位置を移動
                    wdApp.Selection.MoveStart Unit:=wdCharacter, Count:=n先頭位置 - 1
                    '結果をExcelへ書く、
                    p = wdApp.Selection.Range.Information(wdActiveEndPageNumber)
                    l = wdApp.Selection.Range.Information(wdFirstCharacterLineNumber)
                    With ThisWorkbook.Worksheets("結果")
                        .Range("A" & iRow) = p & "P、" & l & "行目"
                        .Range("B" & iRow) = wd
                    End With
                    iRow = iRow + 1
                End If
                            
                '次の位置(見つけた位置+検索文字数)から検索文字を探す
                n先頭位置 = InStr(n先頭位置 + Len(wd), str段落文字列, wd) '同じ段落に検索文字があるかもしれないので
            
            Wend
            
        Next n
        
    Next

    MsgBox "処理終了、結果を確認してください"

End Sub

'WORDの単体テストソースコード
Option Explicit

Sub test20220121段落Paragraphsのテスト()

    Dim n As Integer
    
    For n = 1 To ActiveDocument.Paragraphs.Count
        Debug.Print n & ":" & ActiveDocument.Paragraphs(n).Range.Text
    Next n

End Sub


Sub test20220121選択位置の情報_Range_Informationテスト()
    Dim p As Integer
    Dim l As Integer
    
    p = Selection.Range.Information(wdActiveEndPageNumber) 'ページ
    l = Selection.Range.Information(wdFirstCharacterLineNumber) '行
    
    MsgBox "現在選択されている位置: " & p & "P、" & l & "行目です"
    
End Sub


Sub test20220121段落Paragraphsから文字列を探し段落を選択状態にして位置表示()

    Dim n As Integer
    Dim str検索文字列 As String
    
    str検索文字列 = InputBox("検索文字を入れて", "検索テスト", "検索文字列")
    
    'アクティブ文書の段落を頭からなめる ActiveDocument.Paragraphs
    For n = 1 To ActiveDocument.Paragraphs.Count
        Debug.Print n & ":" & ActiveDocument.Paragraphs(n).Range.Text
        '単純にInstrで探してみた
        If InStr(ActiveDocument.Paragraphs(n).Range.Text, str検索文字列) > 0 Then
            ActiveDocument.Paragraphs(n).Range.Select   '見つけたので選択する
            Exit For  '見つけたのでループを抜ける、なめまわすのをやめる
        End If
    Next n

    Dim p As Integer
    Dim l As Integer
    
    p = Selection.Range.Information(wdActiveEndPageNumber) 'ページ
    l = Selection.Range.Information(wdFirstCharacterLineNumber) '行
    
    MsgBox "現在選択されている位置: " & p & "P、" & l & "行目です"

    'あっ↑で、検索文字列が見つからなかった時の処理が入ってないや、
    'まぁ、単体テストだからいっか、ぉぃぉぃ

    'バグ・不具合:段落全体を.Paragraphs(n).Range.Selectしているので、
    'Selection.Range.Information(wdFirstCharacterLineNumber) '行
    '段落の行を返してしまう。
    '段落内に4行文字列があり、3行目に検索文字列があった時、正しい行数をgetできない

End Sub


'Selectionの位置を移動させるテスト※選択範囲を変更するテスト
'Selection.MoveStart Unit:=wdCharacter, Count:= で範囲先頭を移動
Sub test20220121段落選択後に検索文字の先頭に範囲を移動する()

    Dim n As Integer
    Dim str検索文字列 As String
    Dim str段落文字列 As String
    Dim n先頭位置 As Integer
    
    str検索文字列 = InputBox("検索文字を入れて", "検索テスト", "検索文字列")
    
    'アクティブ文書の段落を頭からなめる ActiveDocument.Paragraphs
    For n = 1 To ActiveDocument.Paragraphs.Count
        Debug.Print n & ":" & ActiveDocument.Paragraphs(n).Range.Text
        str段落文字列 = ActiveDocument.Paragraphs(n).Range.Text
        '単純にInstrで探してみた
        n先頭位置 = InStr(str段落文字列, str検索文字列)
        If n先頭位置 > 0 Then '↑で文字が見つかったら、
            ActiveDocument.Paragraphs(n).Range.Select   '見つけたので段落選択する
            '↑段落全体が選択されているので、↓選択範囲、start位置を移動
            Selection.MoveStart Unit:=wdCharacter, Count:=n先頭位置
            Exit For  '見つけたのでループを抜ける、なめまわすのをやめる
        End If
    Next n

    Dim p As Integer
    Dim l As Integer
    
    p = Selection.Range.Information(wdActiveEndPageNumber) 'ページ
    l = Selection.Range.Information(wdFirstCharacterLineNumber) '行
    
    MsgBox "現在選択されている位置: " & p & "P、" & l & "行目です"

    'あっ↑で、検索文字列が見つからなかった時の処理が入ってないや、
    'まぁ、単体テストだからいっか、ぉぃぉぃ

    '段落全体を.Paragraphs(n).Range.Select
    'その後、Selection.MoveStart Unit:=wdCharacter, Count:=文字数
    'Unit:=wdCharacterで文字移動、Countに文字数を入れてみた
    'これで、段落内に4行文字列があり、3行目に検索文字列があった時、正しい行数をgetできるはず

End Sub