【Excel VBA】Wordファイルの表内の文章をExcelに出力するサンプル

Word文書の一部を抽出して一覧にし、集計や分析に活用したいと思ったことはありませんか。

前回の記事では、Wordファイル内の「コメント付き文章」をExcelに一覧出力する方法をご紹介しました。今回はその応用として、Word文書内の表に含まれるデータをExcelに転記するマクロをご紹介します。

内容

アウトプットイメージ
VBAサンプル
応用ポイント

アウトプットイメージ

下図の左側は、Wordファイル内に含まれる表の一部です。
この表から、右上のセルの値、3行目の全データ、そして表全体の内容を抽出し、下図右側のようにExcelの「表から抽出」シートに一覧形式で出力します。

右上（1行目の最終列）、3行目のすべて、表のすべて抽出の事例です — Word文書の表から指定したセル、行などの文字列をExcel出力するアウトプットイメージ

VBAサンプル

VBAのサンプルは次のとおりです。

前提として、VBAを実行するExcelファイルには、あらかじめ出力用のシート「表から抽出」が作成されている必要があります。

３つの抽出事例があり、「右上（1行目の最終列）のみ」、「3行目のすべて」、「表のすべて」の事例です。

Sub Wordファイルの表データをExcelに転記()
    
    ' === 変数宣言 ==='
    Dim ワードアプリ As Object
    Dim ドキュメント As Object
    Dim ファイル名 As Variant
    Dim 出力シート As Worksheet
    Dim 出力行 As Long
    Dim テーブル As Object
    Dim 行 As Long, 列 As Long, 最終列 As Long
    Dim セルの値 As String
    

    ' === Wordアプリケーションの起動 ==='
    Set ワードアプリ = CreateObject("Word.Application")

    ' === Wordファイルの選択 ==='
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Title = "抽出対象のWordファイルを選択"
        .Filters.Clear
        .Filters.Add "Wordファイル", "*.docx"

        If .Show = -1 Then
            ファイル名 = .SelectedItems(1)
        Else
            MsgBox "ファイルが選択されませんでした。処理を中止します。"
            Exit Sub
        End If
    End With

    ' === Word文書のオープン ==='
    Set ドキュメント = ワードアプリ.Documents.Open(ファイル名)

    ' === 出力先シート準備 ==='
    Set 出力シート = ThisWorkbook.Sheets("表から抽出")
    出力シート.Cells.ClearContents
    出力行 = 1

    ' === 最初の表を対象にする ==='
    Set テーブル = ドキュメント.Tables(1)

    ' --- 表の右上セルの値（1行目・最終列） ---'
    出力シート.Cells(出力行, 1).Value = "右上セル"
    セルの値 = テーブル.Cell(1, テーブル.Rows(1).Cells.Count).Range.Text
    出力シート.Cells(出力行, 2).Value = Replace(セルの値, Chr(13) & Chr(7), "")
    出力行 = 出力行 + 2

    ' --- 3行目の全ての値 ---'
    出力シート.Cells(出力行, 1).Value = "3行目の全て"
    For 列 = 1 To テーブル.Rows(3).Cells.Count
        セルの値 = テーブル.Cell(3, 列).Range.Text
        出力シート.Cells(出力行, 列 + 1).Value = Replace(セルの値, Chr(13) & Chr(7), "")
    Next 列
    出力行 = 出力行 + 2

    ' --- 表全体の値 ---'
    出力シート.Cells(出力行, 1).Value = "全データ"
    For 行 = 1 To テーブル.Rows.Count
        最終列 = テーブル.Rows(行).Cells.Count
        
        For 列 = 1 To 最終列
            セルの値 = テーブル.Cell(行, 列).Range.Text
            出力シート.Cells(出力行, 列 + 1).Value = Replace(セルの値, Chr(13) & Chr(7), "")
        Next 列
        
        出力行 = 出力行 + 1
    Next 行


    ' === Word文書とアプリケーションの終了処理 ==='
    AppActivate Application.Caption
    MsgBox "表データの抽出が完了しました。"
        
    ドキュメント.Close False
    Set ドキュメント = Nothing

    ワードアプリ.Quit
    DoEvents ' Word終了待ちの間にExcelの応答を確保'
    Set ワードアプリ = Nothing

End Sub