Help us understand the problem. What is going on with this article?

【ExcelVBA】ExcelのデータをWordに書き込み

■目的

Excelファイルでマクロを実行し、以下の通りWordファイルを操作する
・既に作成されたWordファイルを元に新規Wordファイルを作成
・新規WordファイルのデータをExcelのデータに置き換える
・新規Wordファイルを名前をつけて保存する

■事前準備

・Excelファイルに置き換えデータを記載
・置き換え箇所をキーワード表記にしたコピー元Wordファイルを作成
・ExcelVBAにてライブラリ追加
ツール > 参照設定 > 「Microsoft Word XX.X Object Library」にチェック > OK
※XX.Xはバージョン

■サンプルコード

Option Explicit

Sub CopyToWord()

    '■変数宣言
    'Wordアプリケーションオブジェクト
    Dim wordApp As Word.Application
    'Wordファイルの格納パス
    Dim wordPath As String
    'コピー元Wordファイル名
    Dim sourceWordName As String
    '新規Wordファイル名
    Dim newWordName As String
    '新規Wordドキュメントオブジェクト
    Dim wordObj As Word.Document

    'Excelデータ取得用
    Dim br As Long
    Dim er As Long
    Dim bc As Long
    Dim ec As Long
    Dim mr As Long
    Dim n1 As Integer
    Dim n2 As Integer
    Dim n3 As Integer
    Dim targetData() As String
    Dim findData() As String

    Dim i, j, k, l, n, m, o As Integer

    '■処理
    'Wordアプリケーションオブジェクトの用意
    Set wordApp = CreateObject("Word.Application")

    'Wordファイルの格納パス定義
    wordPath = ThisWorkbook.Path
    'コピー元Wordファイル名定義
    sourceWordName = "template.docx"


    'Excelデータの取得
    mr = 3      '置き換え元文言記載行
    br = 4      'データ開始行番号
    bc = 8      'データ開始列番号
    'データ終了行番号
    er = Cells(Rows.Count, bc).End(xlUp).Row
    'データ終了列番号
    ec = Cells(br, Columns.Count).End(xlToLeft).Column
    '置き換えデータ格納配列定義
    ReDim targetData(er - br, ec - bc)

    n1 = 0
    '行数分繰り返し
    For k = br To er
        n2 = 0
        '項目数分繰り返し
        For l = bc To ec
            '項目格納
            targetData(n1, n2) = Cells(k, l).Text
            n2 = n2 + 1
        Next l
        n1 = n1 + 1
    Next k

    '置き換え元文言格納配列定義
    ReDim findData(ec - bc)

    n3 = 0
    '置き換え元文言分繰り返し
    For n = bc + 1 To ec
        '置き換え元文言格納
        findData(n3) = Cells(mr, n).Value
        n3 = n3 + 1
    Next n


    '置き換え対象ファイル分繰り返し
    For m = 0 To UBound(targetData, 1) - 1

        '新規Wordファイル名定義
        newWordName = targetData(m, 0)

        'Wordファイルをコピー
        FileCopy wordPath & "\" & sourceWordName, wordPath & "\" & newWordName

        '新規Wordファイルを開く
        Set wordObj = wordApp.Documents.Open(wordPath & "\" & newWordName)

        '置き換えデータ分繰り返し
        For o = 0 To UBound(targetData, 2) - 1

            'Excelデータを置き換え
            wordObj.Content.Find.Execute findtext:=findData(o), ReplaceWith:=targetData(m, o + 1), MatchCase:=True, Replace:=wdReplaceAll

        Next o

        'Wordファイルを保存
        wordObj.Save

        'Wordファイルを閉じる
        wordObj.Close

        'Wordオブジェクトの解放
        Set wordObj = Nothing

    Next m

    'Wordアプリケーションオブジェクトの無効化
    Set wordApp = Nothing

End Sub

■サンプルコードの解説

・Excelの内容
image.png

・Wordの内容(テンプレート)
image.png

・Wordの内容(マクロ実行後)
image.png

Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
Comments
Sign up for free and join this conversation.
If you already have a Qiita account
Why do not you register as a user and use Qiita more conveniently?
You need to log in to use this function. Qiita can be used more conveniently after logging in.
You seem to be reading articles frequently this month. Qiita can be used more conveniently after logging in.
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away