Wordのテーブルの(2,2)の値を読んで、その値を指定したExcelの中にあるか検索する方法。【VBA】

経緯

WordにはExcelみたいに”A1”とか”F6”とかなくて、どうやったら、狙った位置に文字や数字が入力できるのか、

今回勉強しました。

InStr()関数を使う

Instr()関数を使うとうまくいきました。

InStr()関数はExcelでいうFind()関数です。

以下がコードです。

まず、検索するワードファイルのテーブルの(2,2)を取得します。これが検索する値です。

次にExcelファイルを読んで、１行目から26行目にあるセルの値が、検索する値を含むかチェックします。

セルが見つかったら、そのアドレスを表示させる

というコードです。

Sub SearchExcelFromWord()

    Dim xlApp As Object
    Dim xlBook As Object
    Dim xlSheet As Object
    Dim folderPath As String
    Dim fileName As String
    Dim searchValue As String
    Dim cell As Object
    Dim found As Boolean
    Dim doc As Document
    Dim tbl As table
    Dim col As Integer

    ' ワードのActiveDocumentを設定
    Set doc = ActiveDocument

    ' ワードの最初のテーブルを設定
    Set tbl = doc.Tables(1)

    ' Wordのテーブルのセル(2,2)の値を取得
    searchValue = tbl.Cell(2, 2).Range.Text
    ' 改行コードと最後の特殊文字を削除
    searchValue = Replace(searchValue, vbCr, "")
    searchValue = Left(searchValue, Len(searchValue) - 1)

    ' Excelオブジェクトの作成
    Set xlApp = CreateObject("Excel.Application")

    ' Excelファイルが格納されているフォルダのパス
    folderPath = "C:\Users\mori\デスクトップ\"

    ' フォルダ内の最初のExcelファイルを取得
    fileName = Dir(folderPath & "*.xlsx")

    ' Excelファイルが存在しない場合はエラーメッセージを表示して終了
    If fileName = "" Then
        MsgBox "フォルダ内にExcelファイルが見つかりませんでした。"
        Exit Sub
    End If

    ' Excelファイルを開く
    Set xlBook = xlApp.Workbooks.Open(folderPath & fileName)

    ' 最初のシートを選択
    Set xlSheet = xlBook.Sheets(1)

    ' フラグの初期化
    found = False

    ' 1行目のA列からZ列までのセルをループ
    For col = 1 To 26
        ' セルの値が検索文字列を含むかチェック
        If InStr(1, xlSheet.Cells(1, col).Value, searchValue) > 0 Then
            ' 該当するセルが見つかった場合はそのアドレスを表示
            MsgBox "Found at " & xlSheet.Cells(1, col).Address(0, 0)
            found = True
            Exit For
        End If
    Next col

    ' 該当するセルが見つからなかった場合はメッセージを表示
    If Not found Then
        MsgBox "Value not found"
    End If

    ' ファイルを閉じる
    xlBook.Close SaveChanges:=False

    ' Excelを閉じる
    xlApp.Quit

    ' オブジェクトを解放
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    Set tbl = Nothing
    Set doc = Nothing

End Sub

こんな感じです。

参考になれば、幸いです。

ここまで読んでいただきありがとうございました。