WordファイルにExcelファイルのリストから1レコードのみ差込印刷するマクロ

１　帳票様式がWordで提供されており，線種や表の高さ，幅，折り返し，ファイルの更新などの懸念があるため，ひな型をExcelに取り込むのを避けたい場合．同一のExcelブック内のリストに基づいてひな型のExcelシートへ差し込むのではなく，ExcelのリストからWordファイルに差し込むことになる．また，Excelのレコードすべて差し込むならwordの差込印刷機能を使うのだが，今回は特定のレコードだけ印刷すればよい．

手作業でやるなら，こんな作業イメージ．

差し込み印刷で 1 枚に 3 レコード分を印刷する｜クリエアナブキのちょこテク

２　インプットのxlsmファイル，アウトプットのdocxファイルを整える．

　(1)レコード一覧.xlsm

　　シート名は「レコード一覧」，先頭行を見出し行とする．ここでは，見出し行として，A1セルに「ID」，B1セルに「文書種類」，C1セルに「文書名」，D1セルに「印刷対象」とする．2行目以降にレコードを書いておく．差込印刷作業とは関係ないが，クリックした行を目立たせるため，A:D列に条件付き書式「=CELL("ROW")=ROW()」を設定しておくことにした．また，Microsoft Wordのオブジェクトライブラリへの参照設定をしておく．

　（2）ひな型.docx

　ひな型のワードファイルは，Excelのマクロ実行ファイル（Thisworkbook)と同階層に「処理対象」フォルダを作成し，そこに1ファイルだけ格納しておく．

　Excelのレコードを差込みたいそれぞれの場所に予めブックマークをつけておく．Word特融の段落をVBAで扱うより分かりやすそうなため，ブックマークでやってみる．

　今回のひな型は，同じレコードを2か所へ出力する形になっていた．1つ目の場所に，bm文書種類1，bm文書名，2つ目の場所にbm文書種類2，bm文書名，のブックマークを設定しておく．

　一括印刷のマクロは，ボツ．2枚目以降が追加で入力されてしまう．初期化できていない．ファイルを毎回閉じて開いてし直さないで何とか処理したいのだが，ブックマークのある箇所の文字削除が分からない．

３　コード

（1）条件付き書式の都度反映（画面更新）（シートモジュール）

’今回の差込印刷作業とは関係ない．

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.ScreenUpdating = True
End Sub

（2）差込（標準モジュール）

 Option Explicit
 '**
 '*一括印刷は，印刷プレビューで確認不要なときのみ使用可
 '*
 Sub 印刷対象列で一括印刷()
    '原義ファイル存在チェック．(このエクセルファイルと同じ階層の「処理対象」フォルダに原義ファイルがあるか)
    Dim fileName  As String: fileName = Dir(ThisWorkbook.Path & "\処理対象\*.doc*")
    If fileName = "" Then
        MsgBox "処理対象フォルダに原義のWordファイルを格納してください"
        Exit Sub
    End If
    
    'Wordを掴む
    Dim objWord As Word.Application: Set objWord = New Word.Application
    objWord.Visible = True
    Dim myFilePath As String: myFilePath = ThisWorkbook.Path & "\処理対象\" & fileName
    Dim Doc As Word.Document: Set Doc = objWord.Documents.Add(myFilePath)
    
    'D列で印刷要否を判定
    With ThisWorkbook.Sheets("レコード一覧")
        Dim iRow As Long
        For iRow = 2 To Sheets("レコード一覧").Cells(.Rows.Count, "A").End(xlUp).Row
            If Val(.Range("D" & iRow).Value) > 0 Then
                Call 差込(Doc, iRow)
                '印刷（印刷中はマクロの実行は中断）
                Doc.PrintOut Background:=False
            End If
        Next
    End With
    
    'Wordを閉じる
    Doc.Close savechanges:=False
    objWord.Quit
    '終了処理
    Set objWord = Nothing
    Set Doc = Nothing
 End Sub

'**
'*印刷プレビューでレイアウト確認してから1レコードのみ印刷する目的
'*
 Sub クリック行のみ印刷()
    '原義ファイル存在チェック
    Dim fileName  As String: fileName = Dir(ThisWorkbook.Path & "\処理対象\*.doc*")
    If fileName = "" Then
        MsgBox "処理対象フォルダに原義のWordファイルを格納してください"
        Exit Sub
    End If
    
    'Wordファイルを掴む
    Dim objWord As Word.Application: Set objWord = New Word.Application
    objWord.Visible = True
    Dim myFilePath As String: myFilePath = ThisWorkbook.Path & "\処理対象\" & fileName
    Dim Doc As Word.Document: Set Doc = objWord.Documents.Add(myFilePath)
    
    'クリックした行のみを印刷．アクティブセルで判定するのでうまくいかないなら要確認
    Dim my印刷行番号 As Long: my印刷行番号 = ActiveCell.Row
    Call 差込(Doc, my印刷行番号)
    
    '印刷プレビュー
    Doc.PrintPreview
    
    'Wordを前面に．
    With objWord
        .WindowState = wdWindowStateMinimize
        .WindowState = wdWindowStateMaximize
    End With
  
    '終了処理
    Set objWord = Nothing
    Set Doc = Nothing
 End Sub

Sub 差込(ByVal Doc As Word.Document, ByVal my印刷行番号 As Long)
    '特段の初期化不要（ブックマークがある場所のテキストを全部書き換えるので）
    With ThisWorkbook.Sheets("レコード一覧")
        Doc.bookmarks("bm文書種類1").Range.Text = .Range("C" & my印刷行番号).Value
        Doc.bookmarks("bm文書種類2").Range.Text = .Range("C" & my印刷行番号).Value
        Doc.bookmarks("bm文書名1").Range.Text = .Range("D" & my印刷行番号).Value
        Doc.bookmarks("bm文書名2").Range.Text = .Range("D" & my印刷行番号).Value
    End With
End Sub

４　参考

（１）

『指定したレコードのみExcelからWordへ差込をするVBA』（VBA初心者）エクセル Excel [エクセルの学校]

　エクセルの学校のたたき台に引っ張られたが，ブックマークではなくて，単にワードひな型の何段落目に差込みたいのか数えてから，Paragraphs(index) を使った方がシンプルかもしれない．ブックマーク機能なんて，普通知らないし．

    '差込
    With ThisWorkbook.Sheets("レコード一覧")
        Doc.parafraphs(12).Range.Text = .Range("C" & my印刷行番号).Value
        Doc.parafraphs(7).Range.Text = .Range("D" & my印刷行番号).Value
        Doc.parafraphs(13).Range.Text = .Range("D" & my印刷行番号).Value
    End With

みたいな形で．と思ってやってみたところ，Paragraphs()を正しく摑まえるのが面倒でうまくできなかった．やはりブックマークでやることにした．未確認だが，自分のマクロで書いた後ろのParagraphsが変わってしまうなら，最後尾のParagrahsから記載していく必要がありそう．

（２）

http://tips.asablo.jp/blog/2018/06/07/8881562

Wordのアプリケーションを最前面にもってくるのが最初うまくいかなかった．

「objWord.Activate」ではWin１０環境ではExcelからWordを前面に持ってくるのはうまくいかないみたい．

「objWord.Windows(1).Activate」は間違っていてエラー．

「AppActivate Doc.Windows(Doc.Windows.Count).Caption & " - Word"」

だとうまく前面にもってこれたが，ExcelのバージョンやWordの拡張子（DocかDocxかなど）によってウインドウ上部の表示が安定しないのでイマイチなのでどうしようか困っていたところ，天才がいた．

Windowをアクティブにするという目的に対して，Windowを最小化して，最大化（orNomalに戻す）するという発想．Win７以降は，他のアプリケーションウィンドウを前面に持ってくるのは誤操作の原因となる迷惑行為という位置づけなので通常できないらしい．https://stackoverflow.com/questions/4955366/why-doesnt-word-come-to-front-when-we-activate-it

（３）

　処理対象フォルダ内の原義ファイルをDirで掴むとき，「.doc*」としているが，Dirは拡張子先頭3文字しか掴めないため，「.doc」と同じことを明示しただけ．