Q&A
VBA初心者です。
Excelの用語リストをWordで検索をかけ、検索結果の前後5文字を含めてExcelに抽出したいです。
◆実現したいこと
・Wordの本文・表・テキストボックスを対象に、用語リストの単語を検索にかける
・検索してヒットした前後8文字を含めた分を抽出(表・テキストボックスは前後の文字が5文字ない場合もあります)
・該当のページ番号も抽出
・できれば抽出結果は新規Workbookに作成し、シート名は対象のWordファイル名にしたい
・できれば前後の文字数は都度設定できるようにしたい
・できればWordを複数ファイル対象にしたい
・できればWordの検索してヒットした単語を蛍光ペンでマークしたい
◆仕上がりの理想像
Word例文:
7/28PMまでに、6TBの外付けハードディスクを、TBSDXビジネス局の鈴木PM様宛に送って下さい。
Excel用語リスト例:
用語 | 意味 | |
---|---|---|
PM | プロジェクトマネージャー | |
SD | SDカード | |
TB | テラバイト |
希望の抽出結果例:
用語 | 使用部分 | ページ番号 |
---|---|---|
PM | 7/28PMまでに、1 | 1 |
PM | ス局の鈴木PM様宛に送っ | 1 |
SD | クを、TBSDXビジネス | 1 |
TB | カードと6TBの外付けハ | 1 |
TB | ィスクを、TBSDXビジ | 1 |
発生している問題・エラーメッセージ
実行時エラー’438 オブジェクトは、このプロパティまたはメソッドをサポートしていません
該当のソースコード
VBA
1Sub 用語検索() 2 3Dim wdApp As Word.Application 4Set wdApp = GetObject(, "Word.Application") 5 6Dim i, MaxR, iRow As Integer 7MaxR = Sheets("用語リスト").Cells(Rows.Count, 1).End(xlUp).Row 8iRow = 2 9 10Dim wd As Variant 11Dim Page As Variant 12Dim wdStart, wdEnd As Variant 13Dim myRange As Range 14 15For i = 10 To MaxR 16 wd = ThisWorkbook.Worksheets("用語リスト").Range("A" & i + 1).Value 17 With wdApp.Selection 18 .Move unit:=wdStory, Count:=-1 '文章の先頭にカーソルを移動 19 .Find.Text = wd 20 .Find.Forward = True 21 .Find.MatchWholeWord = True 22 .Find.MatchCase = True 23 .Find.Wrap = wdFindContinue 24 Do While .Find.Execute 25 myRange = Selection.Range(Start:=Selection.Character.Start - 5, End:=Selection.Character.End + 5) 26 Page = .Information(wdActiveEndPageNumber) 27 With ThisWorkbook.Worksheets("結果") 28 .Range("A" & iRow) = wd 29 .Range("B" & iRow) = myRange 30 .Range("C" & iRow) = Page 31 End With 32 iRow = iRow + 1 33 Loop 34 End With 35Next 36 37Application.ScreenUpdating = True 38Set wdApp = Nothing 39 40MsgBox "完了しました" 41 42End Sub
試したこと
myRange = Selection.Range(Start:=Selection.Character.Start - 5, End:=Selection.Character.End + 5)
ここでひっかかるので、おかしいのだと思いますが、どうすればよいかわからず、、
補足情報(FW/ツールのバージョンなど)
ここにより詳細な情報を記載してください。
回答1件
下記のような回答は推奨されていません。
このような回答には修正を依頼しましょう。