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
なかなか、VBA 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.段落と行数は違うので、選択位置を移動する
