VBA(Word WdInformation取得)

https://learn.microsoft.com/ja-jp/office/vba/api/word.wdinformation
https://tonari-it.com/word-vba-find-execute/
https://qiita.com/t-yama-3/items/89300fbab045738b604e

-- 1. 開発タブの挿入でボタンを作成
※ActiveXコントロールのものを使用する

-- 2. デザインモードONで作成したボタンをダブルクリックするとエディタが開くので下記コードを記載。デザインモードOFFで実行

※ 下記設定必要
「Microsoft Word 16.0 Object Library」の参照設定

Option Explicit

Private Sub CommandButton1_Click()

'画面を更新しない
Application.ScreenUpdating = False
'確認メッセージを表示しない
Application.DisplayAlerts = False

Dim Wd As New Word.Application
Dim Doc As Word.Document

If Dir(ThisWorkbook.Path & "\" & "test2.docx") <> "" Then
    Kill ThisWorkbook.Path & "\" & "test2.docx"
End If

FileCopy ThisWorkbook.Path & "\" & "test.docx", ThisWorkbook.Path & "\" & "test2.docx"

Set Doc = Wd.Documents.Open(ThisWorkbook.Path & "\" & "test2.docx")

 

Const Cnum As String = ".1234567890"

With Doc.ActiveWindow
    .Selection.Find.Text = "GB"
    
    Do While .Selection.Find.Execute
    
        .Selection.Range.HighlightColorIndex = wdBrightGreen
        
        
        Dim info1 As Long
        Dim info2 As Long
        Dim info3 As Long
        Dim info4 As Long
        Dim info5 As Long
        Dim info6 As Long
        Dim info7 As Long
        Dim info8 As Long
        Dim info9 As Long
        Dim i  As Long
        Dim i2 As Long
        
        info1 = .Selection.Range.Information(wdActiveEndAdjustedPageNumber)
        
        info2 = .Selection.Range.Information(wdStartOfRangeRowNumber)
        info3 = .Selection.Range.Information(wdStartOfRangeColumnNumber)
        
        info4 = .Selection.Range.Information(wdEndOfRangeRowNumber)
        info5 = .Selection.Range.Information(wdEndOfRangeColumnNumber)
        
        info6 = .Selection.Range.Information(wdFirstCharacterLineNumber)
        info7 = .Selection.Range.Information(wdFirstCharacterColumnNumber)
        
        info8 = .Selection.Range.Information(wdMaximumNumberOfRows)
        info9 = .Selection.Range.Information(wdMaximumNumberOfColumns)
        
        i = .Selection.Range.Start
        i2 = .Selection.Range.End
        
        Debug.Print "info1= " & info1
        Debug.Print "info2= " & info2
        Debug.Print "info3= " & info3
        Debug.Print "info4= " & info4
        Debug.Print "info5= " & info5
        Debug.Print "info6= " & info6
        Debug.Print "info7= " & info7
        Debug.Print "info8= " & info8
        Debug.Print "info9= " & info9
        
        Debug.Print "i= " & i
        Debug.Print "i2= " & i2
        
        
        Dim s As String
        Dim s2 As String
        Dim s3 As String
        
        Dim j As Long
        
        s = ""
        s2 = ""
        
        
        j = i - 5
        
        Do While j < i
        
            Doc.Range(j, j + 1).HighlightColorIndex = wdYellow
            
            s = Doc.Range(j, j + 1).Text
            If InStr(Cnum, s) = 0 Then
                s = ""
            End If
            s2 = s2 & s
            j = j + 1
        Loop
        
        Debug.Print "s2=" & s2
        
        s = ""
        s3 = ""
        
        j = i2
        
        Do While j < i2 + 5
            Doc.Range(j, j + 1).HighlightColorIndex = wdRed
            
            s = Doc.Range(j, j + 1).Text
            If InStr(Cnum, s) = 0 Then
                s = ""
            End If
            s3 = s3 & s
            j = j + 1
        Loop
        
        Debug.Print "s3=" & s3
        
    
    Loop
End With

 

 

Doc.Save
Doc.Close

Wd.Quit
Set Doc = Nothing
Set Wd = Nothing

MsgBox "処理完了"

'確認メッセージを表示する
Application.DisplayAlerts = True
'画面を更新する
Application.ScreenUpdating = True

End Sub