「差し込み印刷」を使わないでExcelからWordへの差し込み(差し込み印刷もどき)

　Wordの「差し込み印刷」は簡単で便利だが、データソースの指定等の人手作業が
必要であり全自動化できない（私の勉強不足？）。
　そこでWordの「差し込み印刷」を使用しないで同等の機能をExcel VBAで作ってみた。
作成にあたりここを参照させて頂きました。
新しくここにCSVデータを表形式にしてWordに差し込む方式を作成してみました。

概要

• Wordの文書内のExcelデータを差し込む箇所を"{項目名n}"と記述

• Excel側に差し込むデータを以下のように記述

ファイル名	項目名1	項目名2	・・・
ファイル名1	データ11	データ12	・・・
ファイル名2	データ21	データ22	・・・



• Excelの実行ボタンを押すと、項目名nにデータｎを差し込んだファイル名nのWordファイルを作成

サンプル（Excelのデータで請求書をWordで作成作成するサンプル）

• ダウンロード　Wordファイル(template.docx)はこちら、Excelファイル(wordReplacement.xlsm)はこちら
• サンプルのWord、Excelファイルは同じフォルダー内に保存
• Ｅｘｃｅｌファイル（dataReplacement.xlsm）を起動すると、セキュリティの警告がでますがコンテンツの有効化ボタンをクリック。
• 実行ボタンを押すと、表の宛先分の請求書ファイルが同じフォルダーに作成されます。

Excel VBAコード

Option Explicit

 Sub WordDocDupulicate()
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    Dim wdRng As Word.Range
    Dim Fname   As String
    Dim sOutput As String
 
    Dim mPath   As String
    Dim iRowCount As Long
    Dim jColCount As Long
    Dim sh As Worksheet
    Set wdApp = New Word.Application
 
    Const dataSheet As String = "data"
    Const dataItem  As Long = 3         '項目行
    
    Set sh = Worksheets(dataSheet)
    sh.Select
 
    mPath = ActiveWorkbook.Path & "\"
    Fname = mPath & "template.docx"
 
    sOutput = mPath & "\"
    
    On Error GoTo ErrHandler
    'テンプレート文書
    If Dir(Fname) = "" Then
        MsgBox "テンプレート文書がありません。", vbExclamation
        GoTo ErrHandler
    End If
    
    iRowCount = dataItem + 1         '先頭data行
    
    Do
        With wdApp
            Set wdDoc = .Documents.Open(Fname)
            Set wdRng = wdDoc.Content
        End With
        
        jColCount = 1
        Do
            Debug.Print "項目: " & Cells(dataItem, jColCount).Value
            Debug.Print "置換: " & Cells(iRowCount, jColCount).Value
        
            With wdRng.Find
                .Text = "{" & Cells(dataItem, jColCount).Value & "}"
                .Forward = True
                If Cells(dataItem, jColCount).Value = "日付" Then
                    .Replacement.Text = Format(Cells(iRowCount, jColCount).Value, "gggee年mm月dd日")
                Else
                    .Replacement.Text = Cells(iRowCount, jColCount).Value
                End If
                .MatchCase = False
                .MatchWildcards = False
                .MatchFuzzy = True
                '.Execute Replace:=wdReplaceAll 'Ver Word2003
                .Execute , , , , , , , , , , wdReplaceAll
            End With
            jColCount = jColCount + 1
       Loop Until sh.Cells(iRowCount, jColCount).Value = ""
   
       sOutput = mPath & Cells(iRowCount, 1).Value & ".docx"
       Debug.Print "sOutput: " & sOutput
        
       wdDoc.SaveAs sOutput '保存word文書名
       wdDoc.Close False
       iRowCount = iRowCount + 1
   Loop Until sh.Cells(iRowCount, 1).Value = ""
   wdApp.Quit

ErrHandler:
    If Err.Number > 0 Then
        MsgBox Err.Number & " : " & Err.Description
    Else
        Beep '正常終了
    End If
    Set wdRng = Nothing
    Set wdDoc = Nothing
    Set wdApp = Nothing
    Set sh = Nothing
End Sub

コメント 1

拝見させていただきました。
ワード文書名が英字、コード側の文書名部分がカタカナであるこの以外にミスなく実行しました。すばらしいです。
ところで、私が利用したいのは住所録などハガキ印刷ですが、tyama0467さんのサンプルは各人の名前で文書名が保存され、人数分だけ文書が出来上がりますね、会社の請求書などではそれでもいいのですが、ハガキ印刷などは1つの文書に何ページもつながっていて、印刷作業を１回で済む、もしくは何ページから何ページと指定できたらいいなと思いますが、そんなことはできないですか？
じつは私は市の民生委員をしていて、毎年町内の１５００名のお年寄りにハガキを郵送する作業があり、エクセル＿ワードでできればいいな　と思いコメントさせてもらいました。
現在は、ワードの差し込み印刷を利用していますが、少しエクセルのＢＶＡをかじっているので、関心があります。
宜しくお願いします。
ＵＲＬはありませんので、メールアドレスを記述しておきます。
address:[e-mail]
by 山本　益夫 (2017-04-25 05:58)