【連載】差し込み印刷のレコードごとにドキュメントを作成するマクロの解説(第7回)

第7回 ループ処理に書き換える

前回

akashi-keirin.hatenablog.com

までで、ついに

データ(笑)を差し込んだ新規文書をちょっと手入れして名前を付けて保存する

という核心部分の処理が出来上がりました。

今回は、この処理をループ処理に書き換えます。

時は来た。それだけだ!

目次

ループ回数の上限を求める

ここまで使ってきたコードでは、差し込み印刷用文書(sample.docm)に差し込むデータ(笑)は、

mds.ActiveRecord = 1
mds.FirstRecord = 1
mds.LastRecord = 1

このように、全部「1」。〝決め打ち〟でした。

しかしながら、差し込み印刷というものは、自動で全レコードを順に差し込んでくれるからありがたいのであって、手動で一つ一つレコードを指定しなくてはいけないのでは、オートフィーダーのあるコピー機で原稿を一枚一枚ガラスの上にセットするようなものです。

それではタンザニアのイカンガーでしょう。

そこで、For ... Nextループを使います。

ループの始点は`1`で良いとして、終点はどうするか。

答えは簡単です。差し込みデータ(笑)の件数にすれば良いですね。

このとき

そして、このおじさんが知っている差し込みデータ用のテーブル、すなわち文書に接続されているテーブルがMailMergeDataSourceオブジェクトです。

MailMergeDataSourceオブジェクトはおじさん、すなわちMailMergeオブジェクトにぶら下がっているオブジェクトです。

MailMergeDataSourceオブジェクトは、MailMergeオブジェクトのDataSourceプロパティを叩くことで取得することができます。

こう述べたように、差し込み印刷用文書(sample.docm)に接続されているソースデータを表すMailMergeDataSourceオブジェクトは、文書本体を表すDocumentオブジェクトにぶら下がっているMailMergeオブジェクトにぶら下がっていますので、

Dim doc As Document
Set doc = ThisDocument
Dim mm As MailMerge
Set mm = doc.MailMerge
mm.Destination = wdSendToNewDocument
mm.SuppressBlankLines = True
Dim mds As MailMergeDataSource
Set mds = mm.DataSource

このように、MailMergeオブジェクトのDataSourceプロパティを叩いてやれば取得することができます。

このMailMergeDataSourceオブジェクトが何件のレコードを持っているのか調べるには、コチラにあるように、RecordCountプロパティを叩きます。

したがって、変数mdsMailMergeDataSourceオブジェクトが格納されているとすると、

Dim recCnt As Long
recCnt = mds.RecordCount

としてやれば、変数recCntにレコード件数を突っ込むことができます。

これであとは、

Dim i As Long
For i = 1 To recCnt

Next

というブロック内に、データ(笑)を差し込んで新規文書を整えて名前を付けて保存する処理を入れ込むだけです。

時は来た。それだけだ!

Forブロックに処理を入れ込む

では、前回までのコードFor ... Nextに入れ込みます。

リスト1
Public Sub ExportMailMergeDocuments()
    ' Documentオブジェクト取得
    Dim doc As Document
    Set doc = ThisDocument
    ' MailMergeオブジェクト取得
    Dim mm As MailMerge
    Set mm = doc.MailMerge
    ' MailMergeオブジェクトの初期設定
    mm.Destination = wdSendToNewDocument
    mm.SuppressBlankLines = True
    ' MailMergeDataSourceオブジェクト取得
    Dim mds As MailMergeDataSource
    Set mds = mm.DataSource
    ' レコード数取得
    Dim recCnt As Long
    recCnt = mds.RecordCount
    
    ' Forループで差し込み→ファイル作成
    Dim i As Long
    For i = 1 To recCnt
        ' 差し込むレコードと始点・終点をセット
        mds.ActiveRecord = i
        mds.FirstRecord = i
        mds.LastRecord = i
        ' You 差し込みやっちゃいなよ
        Call mm.Execute( _
            Pause:=True _
        )
        ' 生み出された新規文書を即取得
        Dim newDoc As Document
        Set newDoc = Application.ActiveDocument
        ' 文書末尾の余分なセクション区切りをポア
        Dim lastSection As Section
        Set lastSection = newDoc.Sections(newDoc.Sections.Count)
        If lastSection.Range.Start = newDoc.Content.End - 1 Then
            Call lastSection.Range.Previous(Unit:=wdCharacter, Count:=1).Delete
        End If
        ' 今となっては不要の先頭ページもポア
        ' (狡兎死して走狗烹らる)
        Call newDoc.Range(0, 0).Select
        Dim firstPageRng As Range
        Set firstPageRng = newDoc.Bookmarks.Item("\Page").Range
        Call firstPageRng.Delete
        ' 保存用のファイルパスを組み立てる
        Dim dirPath As String
        dirPath = ThisDocument.Path & "\★作成した文書\"
        Dim tgtFilename As String
        tgtFilename = "諸葛亮曰く" & "_" & Format(mds.DataFields.Item("ID"), "00") & ".docx"
        ' You、保存、やっちゃいなよ
        Call newDoc.SaveAs2( _
            FileName:=dirPath & tgtFilename _
        )
        ' 保存した文書を閉じる
        Call newDoc.Close( _
            SaveChanges:=False _
        )
    Next
End Sub

処理の段階ごとにコメントを付けておきました。

エラー対応などは一切ない骨組みだけのコードですが、必要な機能は揃っています。

動作確認

実行前の保存用フォルダは

保存用フォルダは空

この状態です。

データソースであるExcelのワークシートが接続されている状態ならば、リスト1のマクロを実行してやると、

ファイルが保存された

このように、レコード数分のWordドキュメントが出来上がりました。

中身もバッチリ

中身もばっちりです。

おわりに

ここまで、どうだったでしょうか。

しくみをしっかり理解することができれば、いろいろと応用もできるでしょう。

私は、前職時代、これを応用して差し込みレコードごとにPDFドキュメントを作成する、といったマクロを作成したりしていました。

まあ、わざわざ差し込み印刷機能なんか使わなくても、かんたんなデータ差し込みなら

akashi-keirin.hatenablog.com

こんなふうに、Wordの〝ブックマーク〟機能を使っても良いのですが。

これはこれでWordのマクロ上でExcelのオブジェクトを取得・操作する必要があって、めんどくさいかもしれませんね。

次回からは仕上げの作業に移ります。

関連記事

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com

【連載】差し込み印刷のレコードごとにドキュメントを作成するマクロの解説(第6回)

第6回 新規文書に名前を付けて保存する

前回、

akashi-keirin.hatenablog.com

データ(笑)を差し込んで新規作成した文書について、コマンドボタンを置いた1ページ目を削除するところまで進みました。

今回は、この文書に名前を付けて保存する処理に進みます。

ファイル名を付けるに当たっては、データ(笑)元のテーブルの値を使うことにします。

目次

保存するファイルのフルパスを決定する

ファイルを保存するには、そのファイルのフルパスを決定する必要があります。

順に取得していきましょう。

保存先のフォルダパスを取得する

まず、フォルダのパスを取得します。

今回のプロジェクトでは、差し込み印刷用文書と同じフォルダに置いた「★作成した文書」フォルダに保存することとします。

差し込み印刷用文書、すなわち今回作成しているマクロを置いている文書のあるフォルダのパスは、

ThisDocument.Path

で取得することができます。

そのフォルダ直下にある「★作成した文書」フォルダなので、

ThisDocument.Path & "\★作成した文書\"

とすればオッケーです。

ファイル名に使う値を取り出す

今回差し込み印刷に使うテーブルは、

ID Phrase
1 ほかにすることはないのですか。
2 成功です。ふふふ……。
3 きっとうまくいくでしょう。

というものです。

Phraseカラムの値を文書に差し込むので、IDカラムの値をファイル名の連番に使うことにします。

1つ目のレコードを差し込んだファイルの場合、ファイル名を

諸葛亮曰く_01.docx

のように、IDカラムの値をゼロ埋め2けたの文字列にして、_(アンダースコア)とともに「諸葛亮曰く」の末尾に付けることにします。

Documentオブジェクトに接続している差し込みデータ用テーブルのレコードからIDカラムの値を取得するには、

  1. DocumentオブジェクトのMailMergeプロパティを叩いてMailMergeオブジェクトを取得する
  2. MailMergeオブジェクトのDataSourceプロパティを叩いてMailMergeDataSourceオブジェクトを取得する
  3. MailMergeDataSourceオブジェクトのDataFieldsプロパティを叩いて、MailMergeDataFieldsコレクション・オブジェクトを取得する
  4. MailMergeDataFieldsコレクション・オブジェクトのItemメソッドにカラム名を渡す

このようにします。

リスト1
Private Sub ExportMailMergeDocuments()
    Dim doc As Document
    Set doc = ThisDocument
    Dim mm As MailMerge
    Set mm = doc.MailMerge
    mm.Destination = wdSendToNewDocument
    mm.SuppressBlankLines = True
    Dim mds As MailMergeDataSource
    Set mds = mm.DataSource
    mds.ActiveRecord = 1
    mds.FirstRecord = 1
    mds.LastRecord = 1
    Call mm.Execute( _
        Pause:=True _
    )
    Dim newDoc As Document
    Set newDoc = Application.ActiveDocument
    Dim lastSection As Section
    Set lastSection = newDoc.Sections(newDoc.Sections.Count)
    If lastSection.Range.Start = newDoc.Content.End - 1 Then
        Call lastSection.Range.Previous(Unit:=wdCharacter, Count:=1).Delete
    End If
    Call newDoc.Range(0, 0).Select
    Dim firstPageRng As Range
    Set firstPageRng = newDoc.Bookmarks.Item("\Page").Range
    Call firstPageRng.Delete
End Sub

このコードの

Dim doc As Document
Set doc = ThisDocument
Dim mm As MailMerge
Set mm = doc.MailMerge
mm.Destination = wdSendToNewDocument
mm.SuppressBlankLines = True
Dim mds As MailMergeDataSource
Set mds = mm.DataSource
mds.ActiveRecord = 1
mds.FirstRecord = 1
mds.LastRecord = 1
Call mm.Execute( _
    Pause:=True _
)

この部分で、差し込み印刷用文書を表すDocumentオブジェクトのMailMergeオブジェクトのExecuteメソッドによって1件目のレコードを闘魂注入しています。

変数mdsには、すでに差し込みデータ用テーブルの1件目のレコードが格納されていますので、

mds.DataFields.Item("ID")

としてやれば、1件目のレコードのIDカラムの値である1が返ることになります。

したがって、「諸葛亮曰く_01.docx」という文字列を組み立てるには、

"諸葛亮曰く" & "_" & Format(mds.DataFields.Item("ID"), "00") & ".docx"

とします。

保存するファイルのフルパスを作る

これで、保存するファイルのフルパスを組み立てる準備ができました。

リスト2
ソースコードを
Public Sub ExportMailMergeDocuments()
                Dim doc As Document
    Set doc = ThisDocument
    Dim mm As MailMerge
    Set mm = doc.MailMerge
    mm.Destination = wdSendToNewDocument
    mm.SuppressBlankLines = True
    Dim mds As MailMergeDataSource
    Set mds = mm.DataSource
    mds.ActiveRecord = 1
    mds.FirstRecord = 1
    mds.LastRecord = 1
    Call mm.Execute( _
        Pause:=True _
    )
    Dim newDoc As Document
    Set newDoc = Application.ActiveDocument
    Dim lastSection As Section
    Set lastSection = newDoc.Sections(newDoc.Sections.Count)
    If lastSection.Range.Start = newDoc.Content.End - 1 Then
        Call lastSection.Range.Previous(Unit:=wdCharacter, Count:=1).Delete
    End If
    Call newDoc.Range(0, 0).Select
    Dim firstPageRng As Range
    Set firstPageRng = newDoc.Bookmarks.Item("\Page").Range
    Call firstPageRng.Delete
    
    ' フォルダパスを取得する
    Dim dirPath As String
    dirPath = ThisDocument.Path & "\★作成した文書\"
    ' ファイル名を組み立てる
    Dim tgtFilename As String
    tgtFilename = "諸葛亮曰く" & "_" & Format(mds.DataFields.Item("ID"), "00") & ".docx"
End Sub

これで、

dirPath & tgtFilename

とすれば、保存するファイルのフルパスを取得することができます。

保存してファイルを閉じる

これで準備完了。まさに「時は来た!」状態です。

リスト3
ソースコードを
Public Sub ExportMailMergeDocuments()
    Dim doc As Document
    Set doc = ThisDocument
    Dim mm As MailMerge
    Set mm = doc.MailMerge
    mm.Destination = wdSendToNewDocument
    mm.SuppressBlankLines = True
    Dim mds As MailMergeDataSource
    Set mds = mm.DataSource
    mds.ActiveRecord = 1
    mds.FirstRecord = 1
    mds.LastRecord = 1
    Call mm.Execute( _
        Pause:=True _
    )
    Dim newDoc As Document
    Set newDoc = Application.ActiveDocument
    Dim lastSection As Section
    Set lastSection = newDoc.Sections(newDoc.Sections.Count)
    If lastSection.Range.Start = newDoc.Content.End - 1 Then
        Call lastSection.Range.Previous(Unit:=wdCharacter, Count:=1).Delete
    End If
    Call newDoc.Range(0, 0).Select
    Dim firstPageRng As Range
    Set firstPageRng = newDoc.Bookmarks.Item("\Page").Range
    Call firstPageRng.Delete
    
    ' フォルダパスを取得する
    Dim dirPath As String
    dirPath = ThisDocument.Path & "\★作成した文書\"
    ' ファイル名を組み立てる
    Dim tgtFilename As String
    tgtFilename = "諸葛亮曰く" & "_" & Format(mds.DataFields.Item("ID"), "00") & ".docx"
    ' 文書を保存する
    Call newDoc.SaveAs2( _
        FileName:=dirPath & tgtFilename _
    )
End Sub

これで、文書がファイルとして指定したフォルダに保存されます。

ファイル名が付いた

このように、ウィンドウにファイル名が表示され、

フォルダにファイルが生えた

★作成した文書」フォルダにもファイルが保存されています。

あとは、保存した文書を閉じれば、とりあえず一連の処理が出揃ったことになります。

リスト4
ソースコードを
Public Sub ExportMailMergeDocuments()
    Dim doc As Document
    Set doc = ThisDocument
    Dim mm As MailMerge
    Set mm = doc.MailMerge
    mm.Destination = wdSendToNewDocument
    mm.SuppressBlankLines = True
    Dim mds As MailMergeDataSource
    Set mds = mm.DataSource
    mds.ActiveRecord = 1
    mds.FirstRecord = 1
    mds.LastRecord = 1
    Call mm.Execute( _
        Pause:=True _
    )
    Dim newDoc As Document
    Set newDoc = Application.ActiveDocument
    Dim lastSection As Section
    Set lastSection = newDoc.Sections(newDoc.Sections.Count)
    If lastSection.Range.Start = newDoc.Content.End - 1 Then
        Call lastSection.Range.Previous(Unit:=wdCharacter, Count:=1).Delete
    End If
    Call newDoc.Range(0, 0).Select
    Dim firstPageRng As Range
    Set firstPageRng = newDoc.Bookmarks.Item("\Page").Range
    Call firstPageRng.Delete
    
    ' フォルダパスを取得する
    Dim dirPath As String
    dirPath = ThisDocument.Path & "\★作成した文書\"
    ' ファイル名を組み立てる
    Dim tgtFilename As String
    tgtFilename = "諸葛亮曰く" & "_" & Format(mds.DataFields.Item("ID"), "00") & ".docx"
    ' 文書を保存する
    Call newDoc.SaveAs2( _
        FileName:=dirPath & tgtFilename _
    )
    ' 文書を閉じる
    Call newDoc.Close( _
        SaveChanges:=False _
    )
End Sub

おわりに

ここまでで、

  • データ(笑)を文書に差し込んで新規文書を作成し、
  • 余計な部分を削除し、
  • ファイル名を組み立てて、
  • 所定のフォルダに保存し、
  • 保存した文書を閉じる

という処理が出揃いました。

ただ、現時点では差し込むレコードを、テーブルの1件目のレコードに決め打ちにしている状態です。

次回は、上記コードを接続したテーブルのデータ(笑)の件数分ループする形に書き換えます。

関連記事

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com

Click!!

【連載】差し込み印刷のレコードごとにドキュメントを作成するマクロの解説(第5回)

第5回 1ページ目を削除する

前回

akashi-keirin.hatenablog.com

新規文書作成後にできる余分なセクション区切りの削除まで進みました。

今回は、コマンドボタンを置くためにのみ存在していた1ページ目の削除を行います。

目次

〝ページを削除する〟とは?

Wordにおいて、文書の部分を削除するには、その部分を表すRangeオブジェクトを削除するという方法を用います。

セクションを削除したければ、まずSectionオブジェクトを取得し、そのRangeプロパティを叩いてそのセクションの範囲を表すRangeオブジェクトを取得してからDeleteメソッドで削除します。

' アクティブドキュメントの2つ目のセクションを削除
Dim doc As Document
Set doc = ActiveDocument
Dim sect As Section
Set sect = doc.Sections.Item(2)
Call sect.Range.Delete

段落を削除したければ、まずParagraphオブジェクトを取得し、そのRangeプロパティを叩いてその段落の範囲を表すRangeオブジェクトを取得してからDeleteメソッドで削除します。

' アクティブドキュメントの3つ目の段落を削除
Dim doc As Document
Set doc = ActiveDocument
Dim para As Paragraph
Set para = doc.Paragraphs.Item(3)
Call para.Range.Delete

したがって、文書の1ページ目を削除したければ、

文書の1ページ目を表すRangeオブジェクトを取得して、そのDeleteメソッドを使えば良い

ということになります。

ところがここで難問に出くわします……。

Wordには〝ページ〟を表すオブジェクトがない

という問題です。

〝ページ〟を表すオブジェクトがない

これは、かなり我々の実感に反する実装です。

文書に〝ページ〟という単位があるのは当たり前のように感ずるからです。

ただ、落ち着いてよく考えると、〝ページ〟という単位は実に不安定な単位であることがわかります。

文書の中で、個々の〝ページ〟には確たる境目というものがありません。

この点がセクションや段落、文字とは異なります。

セクションなら、あるセクションと別のセクションの境目には必ずセクション区切りがあります。

段落なら、ある段落と別の段落の境目には必ず改段落マークがあります。

一方、ページの場合、ページと別のページの間にページ区切りが必ずしも存在するわけではありません。

任意の位置にページ区切りを入れることもできますが、基本的に、あるページと別のページの境目は、ページ設定の都合でたまたまそうなっているだけに過ぎないのです。

このような事情で、Wordには〝ページを表すオブジェクト〟が存在しないのでしょう。やはり、理にかなった設計であると思います。

とはいえ、〝特定のページ全体(を表すRangeオブジェクト)を取得したい〟という場面はそれなりにあることでしょう。

このような場合には、Wordの定義済みのブックマークという機能を用います。

〝1ページ目〟のRangeオブジェクト取得・削除

〝定義済みのブックマーク〟とは?

まず、「ブックマーク」とは、文書の任意の範囲に名前を付ける機能だと思えば良いでしょう。

これは、ちょうど、Excelの「名前」機能に似ています。

Excelで、任意のセル範囲に名前を付けて参照することができるように、Wordでも「ブックマーク」という機能によって、文書内の任意の範囲に名前を付け、その名前によって当該範囲を参照することができます。

このように、「ブックマーク」は基本的にはユーザが好きなように設定するものですが、始めから定義されているブックマークがあります。それが今回使用する定義済みのブックマーク(Predefined Bookmarks)です。

「定義済みのブックマーク」はけっこうたくさんありますので、コチラでご確認ください。(日本語版のページだと、自動翻訳のせいで翻訳してはいけないところまで日本語になってしまってイマイチなので、英語版のURLをご案内します。慣れたらむしろ日本語版より読みやすいかも……。)

数ある「定義済みのブックマーク」の中で、今回使用するのは\Pageです。

Current page, including the break at the end of the page, if any. The current page contains the insertion point. If the current selection contains more than one page, the "\Page" bookmark is the first page of the selection. Note that if the insertion point or selection is in the last page of the document, the "\Page" bookmark does not include the final paragraph mark.

この説明にあるように、\Pageというブックマークは、

  • カーソル(insertion point)のあるページの範囲で、
  • 末尾にページ区切りがあるときはページ区切りを含み、
  • 選択範囲が複数ページにわたる場合は選択範囲内の先頭のページの範囲で、
  • カーソル(insertion point)が文書の最終ページにあるときは、末尾の改段落マークを含まない

という範囲のRangeオブジェクトを表すわけです。

……ということは、文書の1ページ目を取得するには、

文書の先頭にカーソル(insertion point)を置いて、「定義済みのブックマーク」/Pageを取得すれば良い

ということです。

文書の1ページ目を取得する

では、「定義済みのブックマーク」のしくみを用いて文書の1ページ目を表すRangeオブジェクトを取得します。手順は次のとおりです。

  1. 文書の1ページ目を表すBookmarkオブジェクトを取得する
  2. BookmarkオブジェクトのRangeプロパティを叩いて文書の1ページ目を表すRangeオブジェクトを取得する

これだけです。

リスト1
ソースコードを
Private Sub ExportMailMergeDocuments()
    Dim doc As Document
    Set doc = ThisDocument
    Dim mm As MailMerge
    Set mm = doc.MailMerge
    mm.Destination = wdSendToNewDocument
    mm.SuppressBlankLines = True
    Dim mds As MailMergeDataSource
    Set mds = mm.DataSource
    mds.ActiveRecord = 1
    mds.FirstRecord = 1
    mds.LastRecord = 1
    Call mm.Execute( _
        Pause:=True _
    )
    Dim newDoc As Document
    Set newDoc = Application.ActiveDocument
    Dim lastSect As Section
    Set lastSect = newDoc.Sections(newDoc.Sections.Count)
    If lastSect.Range.Start = newDoc.Content.End - 1 Then
        Call lastSect.Range.Previous(Unit:=wdCharacter, Count:=1).Delete
    End If
    ' 念のためカーソルを文書の先頭に置く
    Call newDoc.Range(0, 0).Select
    ' 先頭ページを表す`Range`オブジェクトを取得する
    Dim firstPageRng As Range
    Set firstPageRng = newDoc.Bookmarks.Item("\Page").Range
End Sub
        

新規文書作成直後、カーソル(insertion point)は文書の先頭にあるはずですが、念のため

Call newDoc.Range(0, 0).Select

によって明示的に(explicit)カーソル(insertion point)を文書先頭位置に置いています。

DocumentオブジェクトのRangeメソッドの引数は、[Document].Range(start, end)となっています。

引数startendは、ともに文書内の絶対位置を表す数値で、

newDoc.Range(0, 0)

ならば、文書の0文字目から0文字目の位置、すなわち文書の先頭の位置を表すRangeオブジェクトが返ることになります。

文書の先頭位置を表すRangeオブジェクトのSelectメソッドを実行することによって、文書の先頭にカーソル(insertion point)を置いているわけです。

さて、文書の先頭位置にカーソル(insertion point)がある状態で「定義済みのブックマーク」\Pageを取得すれば、そのブックマークは1ページ目全体を指し示すはずなので、

newDoc.Bookmarks.Item("\Page")

で1ページ目全体Bookmarkオブジェクトを取得し、

newDoc.Bookmarks.Item("\Page").Range

Rangeプロパティを叩いて返されるRangeオブジェクトを変数firstPageRngに突っ込んでいます。

1ページ目全体を表すRangeオブジェクトを削除する

こうなると、あとは取得したRangeオブジェクトのDeleteメソッドを実行して削除するだけです。

リスト2
ソースコードを
Private Sub ExportMailMergeDocuments()
    Dim doc As Document
    Set doc = ThisDocument
    Dim mm As MailMerge
    Set mm = doc.MailMerge
    mm.Destination = wdSendToNewDocument
    mm.SuppressBlankLines = True
    Dim mds As MailMergeDataSource
    Set mds = mm.DataSource
    mds.ActiveRecord = 1
    mds.FirstRecord = 1
    mds.LastRecord = 1
    Call mm.Execute( _
        Pause:=True _
    )
    Dim newDoc As Document
    Set newDoc = Application.ActiveDocument
    Dim lastSect As Section
    Set lastSect = newDoc.Sections(newDoc.Sections.Count)
    If lastSect.Range.Start = newDoc.Content.End - 1 Then
        Call lastSect.Range.Previous(Unit:=wdCharacter, Count:=1).Delete
    End If
    ' 念のためカーソルを文書の先頭に置く
    Call newDoc.Range(0, 0).Select
    ' 先頭ページを表す`Range`オブジェクトを取得する
    Dim firstPageRng As Range
    Set firstPageRng = newDoc.Bookmarks.Item("\Page").Range
    ' `Range`オブジェクトを削除する
    Call firstPageRng.Delete
End Sub
        
Call firstPageRng.Delete

で1ページ目を削除します。

Deleteメソッド実行直後

画像では実にわかりづらいのですが、1ページ目がめでたく削除されています。

おわりに

これで、〝データ(笑)を差し込んだ新規文書〟が完成しました。

次回は、この整形済み新規文書に名前を付けて保存する処理を解説します。

関連記事

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com

押すなよ! 絶対押すなよ!

【連載】差し込み印刷のレコードごとにドキュメントを作成するマクロの解説(第4回)

第4回 余分なセクション区切りを削除する

前回

akashi-keirin.hatenablog.com

データ(笑)を差し込んだ新規文書を作成するところまで進んだので、お次はその新規文書を整える、というフェーズです。

ここで、前回の内容をプロシージャにしておきましょう。

リスト1
Public Sub ExportMailMergeDocuments()
    ' 差し込み印刷用文書(`sample.docm`)をDocumentオブジェクトとして取得
    Dim doc As Document
    Set doc = ThisDocument
    ' `MailMerge`オブジェクト取得
    Dim mm As MailMerge
    Set mm = doc.MailMerge
    ' 差し込み方法指定
    mm.Destination = wdSendToNewDocument    ' 新規文書
    mm.SuppressBlankLines = True            ' 空の段落は削除
    ' `MailMergeDataSource`オブジェクト取得
    Dim mds As MailMergeDataSource
    Set mds = mm.DataSource
    ' 差し込みレコードと差し込み範囲の指定
    mds.ActiveRecord = 1
    mds.FirstRecord = 1
    mds.LastRecord = 1
    ' 差し込み実行
    Call mm.Execute( _
        Pause:=True _
    )
End Sub

プロシージャ名は、完成品と同じにしておきます。

今回以降、少しずつ機能を付け足して完成に近づけていきます。

今回、WordのRangeオブジェクトについてかなり詳しく解説しました。

WordのRangeオブジェクトは、少なくともかつての私にとってはかなりとっつきにくい概念でした。

今回の解説を辛抱強く読んでいただければ、かなりRangeオブジェクトに対する理解が進むのではないか、と内心自負しております。

目次

新規ドキュメントを捕まえる

`MailMerge`オブジェクトの`Execute`メソッドを実行すると、データ(笑)を差し込んだ新規文書が生まれます。

この新規文書は、前回

作成した文書は、ApplicationオブジェクトのActiveDocumentプロパティを叩けば捕まえることができる〔以下略〕

と述べたように、非常に簡単にDocumentオブジェクトとして捕まえることができます。

リスト2
ソースコードを
Public Sub ExportMailMergeDocuments()
    ' 差し込み印刷用文書(`sample.docm`)をDocumentオブジェクトとして取得
    Dim doc As Document
    Set doc = ThisDocument
    ' `MailMerge`オブジェクト取得
    Dim mm As MailMerge
    Set mm = doc.MailMerge
    ' 差し込み方法指定
    mm.Destination = wdSendToNewDocument    ' 新規文書
    mm.SuppressBlankLines = True            ' 空の段落は削除
    ' `MailMergeDataSource`オブジェクト取得
    Dim mds As MailMergeDataSource
    Set mds = mm.DataSource
    ' 差し込みレコードと差し込み範囲の指定
    mds.ActiveRecord = 1
    mds.FirstRecord = 1
    mds.LastRecord = 1
    ' 差し込み実行
    Call mm.Execute( _
        Pause:=True _
    )
    ' 新しく生まれたドキュメントを取得
    Dim newDoc As Document
    Set newDoc = Application.ActiveDocument
End Sub

非常に簡単です。これで、新しく生まれたドキュメントにあれこれ手を加えることが可能になりました。

文書末尾の余分なセクション区切りを削除する

さて、新しく生まれた文書ですが、

余分なセクション区切り

このように、余分なセクション区切りが入ってしまいます。

文書の末尾ゆえ、正直実害はないので、放っておいても良いのですが、少し気持ち悪いので削る処理を加えておきましょう。

いろいろなやり方があると思いますが、今回は次の手順で行います。

  • 文書(Documentオブジェクト)内の最後のセクション(Sectionオブジェクト)を取得する
  • セクションの開始位置が文書末尾の1文字前だったら〝文書末尾の余分なセクション〟と見なす
  • 最後のセクションの開始位置から1文字分前の位置まで(=セクション区切り)を削除する

このような手順です。

文書内の最後のセクションを取得する

ここで、Wordの文書、すなわちDocumentオブジェクトについて、オブジェクト構造を確認しておきます。

基本的に、

DocumentSections

SectionParagraphs

ParagraphCharacters

このような構造・関係になっています。

  • Documentオブジェクトには1個以上のSectionオブジェクトのコレクションであるSectionsコレクション・オブジェクトが含まれます。
  • Sectionオブジェクトには1個以上のParagraphオブジェクトのコレクションであるParagraphsコレクション・オブジェクトが含まれます。
  • Paragraphオブジェクトには1個以上の文字のコレクションであるCharactersコレクション・オブジェクトが含まれます。

ここで「1個以上の」としたのは、

まっさらの文書のオブジェクト群の数

このように、全くの白紙の文書であっても、SectionParagraphオブジェクト、Charactersコレクション・オブジェクトが各1個ずつあるからです。

ちなみに、DocumentSectionParagraphという各オブジェクトと違い、単数形のCharacterオブジェクトというものはありません。

また、Sectionsコレクション・オブジェクトだけでなく、Documentオブジェクトから見たら〝孫〟に当たるParagraphsコレクション・オブジェクト、〝曾孫〟に当たるCharactersコレクション・オブジェクトにも、DocumentオブジェクトからそれぞれParagraphsプロパティ、Charactersプロパティを叩くことによって直接アクセスできるようになっています。

いちいち階層をたどっていかなくても良いようになっているわけです。

これはこれで、実にうまい設計だと思います。

さて、以上のことを踏まえると、〝文書内の最後のセクションを取得する〟には、

Documentオブジェクト配下のSectionsコレクション・オブジェクトの最後の要素を捕まえれば良い

ということになります。

リスト3
ソースコードを
Public Sub ExportMailMergeDocuments()
    ' 差し込み印刷用文書(`sample.docm`)をDocumentオブジェクトとして取得
    Dim doc As Document
    Set doc = ThisDocument
    ' `MailMerge`オブジェクト取得
    Dim mm As MailMerge
    Set mm = doc.MailMerge
    ' 差し込み方法指定
    mm.Destination = wdSendToNewDocument    ' 新規文書
    mm.SuppressBlankLines = True            ' 空の段落は削除
    ' `MailMergeDataSource`オブジェクト取得
    Dim mds As MailMergeDataSource
    Set mds = mm.DataSource
    ' 差し込みレコードと差し込み範囲の指定
    mds.ActiveRecord = 1
    mds.FirstRecord = 1
    mds.LastRecord = 1
    ' 差し込み実行
    Call mm.Execute( _
        Pause:=True _
    )
    ' 新しく生まれたドキュメントを取得
    Dim newDoc As Document
    Set newDoc = Application.ActiveDocument
    ' ドキュメントの最後のセクションを取得
    Dim lastSect As Section
    Set lastSect = newDoc.Sections.Item(newDoc.Sections.Count)
End Sub

追加した部分を詳しく見ておきましょう。


Dim lastSect As Section
Set lastSect = newDoc.Sections.Item(newDoc.Sections.Count)

lastSectという変数を用意して、そこに〝文書の最後のSectionオブジェクト〟を突っ込みます。

まず、

newDoc.Sections

で、DocumentオブジェクトのSectionsプロパティを叩いてSectionsコレクション・オブジェクトを取得します。

次に、

newDoc.Sections.Item()

Sectionsコレクション・オブジェクトのItem()メソッドを叩いて、コレクション内のSectionオブジェクトを取得します。

Item()メソッドの引数には、インデックス番号を渡します。

最後のインデックス番号コレクションの要素数

ですから、

newDoc.Sections.Item(newDoc.Sections.Count)

インデックス番号にSectionsコレクション・オブジェクトのCountプロパティを叩いて得られるSectionsコレクション・オブジェクトの要素数を渡しているわけです。

これで、文書内の最後のSectionオブジェクトを取得することができました。

〝文書末尾の余分なセクション〟かどうか判定する

さきほど取得した文書内の最後のSectionオブジェクトが、ほんとうに文書内の最後のSectionオブジェクトなのか、念のため検証します。

リスト4
ソースコードを
Public Sub ExportMailMergeDocuments()
    ' 差し込み印刷用文書(`sample.docm`)をDocumentオブジェクトとして取得
    Dim doc As Document
    Set doc = ThisDocument
    ' `MailMerge`オブジェクト取得
    Dim mm As MailMerge
    Set mm = doc.MailMerge
    ' 差し込み方法指定
    mm.Destination = wdSendToNewDocument    ' 新規文書
    mm.SuppressBlankLines = True            ' 空の段落は削除
    ' `MailMergeDataSource`オブジェクト取得
    Dim mds As MailMergeDataSource
    Set mds = mm.DataSource
    ' 差し込みレコードと差し込み範囲の指定
    mds.ActiveRecord = 1
    mds.FirstRecord = 1
    mds.LastRecord = 1
    ' 差し込み実行
    Call mm.Execute( _
        Pause:=True _
    )
    ' 新しく生まれたドキュメントを取得
    Dim newDoc As Document
    Set newDoc = Application.ActiveDocument
    ' ドキュメントの最後のセクションを取得
    Dim lastSect As Section
    Set lastSect = newDoc.Sections.Item(newDoc.Sections.Count)
    ' 本当に文書末尾の余分なセクションなのか確認する
    If lastSect.Range.Start = newDoc.Content.End - 1 Then
        
    End If
End Sub

取得したSectionオブジェクトが本当に文書末尾の余分なセクションであるならば、

セクションの開始位置は文書末尾の1つ手前の位置

になるはずです。

文書の末尾には、必ず最後の改段落マークがあるはずなので、事実上の最後の要素の位置は、最後の位置マイナス1の位置になる、という理屈です。

そこで、RangeオブジェクトのStartEndプロパティを用います。

Rangeオブジェクトというのは、おおざっぱに言うと

Documentオブジェクト内の〝範囲〟を表すオブジェクト

で、DocumentオブジェクトやSectionオブジェクト、Paragraphオブジェクトから、実にいろいろなやり方で切り出すことができるようになっています。

そして、RangeオブジェクトにはStartEndというプロパティがあり、名前のとおりRangeオブジェクトの開始位置、終了位置を取得・指定できるようになっています。

たとえば、

lastSect.Range.Start

なら、

lastSectに格納したSectionオブジェクトの開始位置

という意味ですし、

newDoc.Content.End

なら、DocumentオブジェクトのContentプロパティは、文書の本文の部分のRangeオブジェクトを返すので、

newDocに格納したDocumentオブジェクトの本文の部分の終了位置

という意味です。

つまり、

lastSect.Range.Start = newDoc.Content.End - 1

という式は、

文書の本文の部分の末尾に、セクション区切りだけの(中身のない)セクションがある

場合にTrueになる、ということです。

余分なセクション区切りを削除する

文書の最後のセクションが余分なセクションであるならば、そのセクションを削除します。

リスト5
ソースコードを
Private Sub ExportMailMergeDocuments()
    Dim doc As Document
    Set doc = ThisDocument
    Dim mm As MailMerge
    Set mm = doc.MailMerge
    mm.Destination = wdSendToNewDocument
    mm.SuppressBlankLines = True
    Dim mds As MailMergeDataSource
    Set mds = mm.DataSource
    mds.ActiveRecord = 1
    mds.FirstRecord = 1
    mds.LastRecord = 1
    Call mm.Execute( _
        Pause:=True _
    )
    Dim newDoc As Document
    Set newDoc = Application.ActiveDocument
    Dim lastSect As Section
    Set lastSect = newDoc.Sections(newDoc.Sections.Count)
    If lastSect.Range.Start = newDoc.Content.End - 1 Then
        Call lastSect.Range.Previous(Unit:=wdCharacter, Count:=1).Delete
    End If
End Sub

追加した

Call lastSect.Range.Previous(Unit:=wdCharacter, Count:=1).Delete

では、RangeオブジェクトのDeleteメソッドを用いてセクション区切りを削除しています。

詳しく見ておきましょう。

lastSect.Range

まず、lastSectに格納されたSectionオブジェクトのRangeプロパティを叩くことによって、セクションの範囲を表すRangeオブジェクトを取得します。

lastSect.RangeRangeオブジェクトとして振る舞うようになります。

lastSect.Range.Previous()

RangeオブジェクトのPreviousメソッドは、引数で指定した分だけ前までさかのぼった範囲のRangeオブジェクトを返します。

ちょうど、マウスで文書の先頭方向に向かってドラッグするような感じです。

lastSect.Range.Previous(Unit:=wdCharacter, Count:=1)

では、引数UnitwdCharacterCount1を指定しているので、

セクションの開始位置(=セクション区切りの直後の位置)から1文字分さかのぼった範囲

すなわち、

「セクション区切り」という文字

そのものの範囲を表すRangeオブジェクトを返すわけです。

そして、そのRangeオブジェクトのDeleteメソッドを実行することにより、Rangeオブジェクト、つまりセクション区切りそのものを削除することができる、という理屈です。

おわりに

ここまで、いかがでしょうか。

WordのRangeオブジェクトについて理解が深まったのであれば幸いです。

かなり長くなってしまったので、続きは次回

関連記事

 

akashi-keirin.hatenablog.com

 

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com

どくいり きけん おしたら しぬで

【連載】差し込み印刷のレコードごとにドキュメントを作成するマクロの解説(第3回)

第3回 MailMergeオブジェクトを使う

前回

akashi-keirin.hatenablog.com

ひととおり準備ができたので、いよいよマクロの作成に移ります。

マクロに盛り込むべき処理は次のとおりです。

  • 差し込みデータを1件文書に差し込んで、新しい文書を作る
  • 新しくできた文書を整える
  • コマンド ボタンを置いてある1ページ目は不要なので削除する
  • 名前を付けて保存する

これを、差し込みデータの件数分繰り返せば良い、ということです。

今回は、上記の処理のうち、まず

差し込みデータを1件文書に差し込んで、新しい文書を作る

処理を取り上げます。

目次

MailMergeオブジェクト

差し込み印刷機能を利用するには、WordのDocumentオブジェクトのMailMergeプロパティを叩いて、MailMergeオブジェクトを取得し、それを使います。

MailMergeオブジェクトとは何か

MailMergeオブジェクトは、Documentオブジェクト配下のオブジェクトです。

Documentオブジェクトにぶら下がっているオブジェクトなので、MailMergeプロパティを叩いてやることで取得することができます。

リスト1
Private Sub test01()
    Dim doc As Document
    Set doc = ThisDocument
    Dim mm AS MailMerge
    Set mm = doc.MailMerge 
End Sub

このようにしてやれば、変数mmMailMergeオブジェクトを突っ込むことができます。(上記マクロは、変数にオブジェクトを突っ込んでいるだけなので、実行しても何も起きません。)

では、このMailMergeオブジェクトとは何者なのか。

大胆にたとえて言います。

データ差し込みおじさん

です。

このおじさん(=MailMergeオブジェクト)は、Wordのドキュメントの中にいて、ドキュメントに差し込みデータ用のテーブルが接続されていたら、そのデータについて知っていて、データを差し込みフィールドに差し込むことができるおじさんです。

なんでMailMergeという名前なのか。

それは、たぶんもともとこの機能が、葉書や封書といった書簡(Mail)に宛名などの可変的なデータを結合させる(Merge)ための機能だったからなのでしょう。

現代人は「Mail」と聞くと即座に〝Eメール〟を思い浮かべてしまいがちですが、この場合の「Mail」は昔ながらの書簡のことだと考えると良いでしょう。

MailMergeDataSourceオブジェクト

そして、このおじさんが知っている差し込みデータ用のテーブル、すなわち文書に接続されているテーブルがMailMergeDataSourceオブジェクトです。

MailMergeDataSourceオブジェクトはおじさん、すなわちMailMergeオブジェクトにぶら下がっているオブジェクトです。

MailMergeDataSourceオブジェクトは、MailMergeオブジェクトのDataSourceプロパティを叩くことで取得することができます。

リスト2
Private Sub test01()
    Dim doc As Document
    Set doc = ThisDocument
    Dim mm AS MailMerge
    Set mm = doc.MailMerge
    ' MailMergeDataSourceオブジェクト取得
    Dim mds As MailMergeDataSource
    Set mds = mm.Datasource
    mds.ActiveRecord = 1
    Debug.Print mds.DataFields("Phrase")
End Sub

上記コードでは、

Dim mds As MailMergeDataSource
    Set mds = mm.Datasource

によって変数mdsMailMergeDataSourceオブジェクト、すなわち今回データソースとしたdata-source.xlsxの「src-data」シートに作成したテーブルを表すオブジェクトを突っ込んでいます。

差し込みデータ

そして、続く

mds.ActiveRecord = 1

によって、MailMergeDataSourceオブジェクトのActiveRecordプロパティに1を指定しています。

こうすることで、MailMergeDataSourceオブジェクトが、データソースの1つ目のレコード、今回の我らのデータ(笑)でいえば、

  • ID: 1
  • Phrase: ほかにすることはないのですか。

であるように振る舞います。

この状態でMailMergeDataSourceオブジェクトのDataFieldsプロパティを叩いてやると、現在アクティブなレコードの列の情報のコレクションオブジェクトであるDataFieldsコレクションオブジェクトを取得することができます。

mds.DataFields("Phrase")のように、コレクションオブジェクトのインデックスに列(カラム)名を渡してやれば、アクティブレコードの当該列(カラム)の値を取得することができます。

したがって、

Debug.Print mds.DataFields("Phrase")

このステートメントを実行すると、現在アクティブになっているレコードのPhrase列(カラム)の値、すなわち「ほかにすることはないのですか。」がイミディエイト・ウィンドウに出力される、ということになります。

イミディエイト ウィンドウに表示された

[MailMerge].Executeメソッド

データ差し込みおじさん、すなわちMailMergeオブジェクトが、差し込むべきレコードを指定するしくみは理解できたでしょうか。

では、いよいよおじさんが実際にデータを差し込んで、新しい文書を作るフェーズです。

おじさんに〝データ差し込み・新規文書作成〟という動作をさせる命令はExecuteメソッドです。

リスト3
Private Sub test02()
    Dim doc As Document
    Set doc = ThisDocument
    Dim mm As MailMerge
    Set mm = doc.MailMerge
    ' データを差し込んで新規文書を作成する
    mm.Destination = wdSendToNewDocument
    ' データがないとき差し込みデータだけの段落は表示しない
    mm.SuppressBlankLines = True
    Dim mds As MailMergeDataSource
    Set mds = mm.DataSource
    ' 差し込み対象レコードと範囲を指定
    mds.ActiveRecord = 1
    mds.FirstRecord = 1
    mds.LastRecord = 1
    ' 差し込み実行
    Call mm.Execute( _
        Pause:=True _
    )
End Sub

Executeメソッド実行の準備

おじさんに〝データ差し込み・新規文書作成〟という動作をさせる前に、どんなふうに実行するのかという方針を伝える必要があります。

このコードでは、まず

' データを差し込んで新規文書を作成する
mm.Destination = wdSendToNewDocument

変数mmに突っ込んだMailMergeオブジェクトのDestinationプロパティに、データ(笑)を差し込んでできた文書の出力先を指定しています。

今回の例では、wdSendToNewDocumentを指定しているので、データ(笑)を差し込んだ文書を新規文書として出力することになります。

次の

' データがないとき差し込みデータだけの段落は表示しない
mm.SuppressBlankLines = True

は、コメントに記したとおり、差し込みデータだけの段落がある場合に、差し込みデータがない場合は段落ごと表示しない、という設定をしています。

たとえば、

差し込みフィールドだけの段落

このように差し込みフィールドが設定されているときに、差し込みレコードのPhrase列(カラム)にデータがあれば

データがあるとき

このように表示されますが、Phrase列(カラム)にデータがないときは、

データがないとき

このように段落ごと削る、という設定です。

差し込みデータだけの段落について、差し込むレコードが差し込むべきデータがない(Blank)行(Line)であった場合に、その段落の表示を抑制する(Suppress)という設定です。

今回の例では、差し込みフィールドは「」の中、すなわち段落の一部なので、SuppressBlankLinesプロパティはTrueでもFalseでも結果はかわりませんが、多くの場合、空の段落を表示してもしかたがないはずなので、Trueにすることが多いと思います。

さて、データを差し込んだ文書をどうするかに関する設定は終わりました。

あとは、どのレコードを使うかに関する設定です。

' 差し込み対象レコードと範囲を指定
mds.ActiveRecord = 1
mds.FirstRecord = 1
mds.LastRecord = 1

この3行がその設定です。

MailMergeDataSourceオブジェクトのActiveRecordプロパティは、現在ドキュメントに差し込むレコードです。1を設定し、1番目のレコードを差し込む設定にしています。

FirstRecordLastRecordプロパティは、その名のとおり、どのレコードからどのレコードまで差し込むかという設定です。

1番目から1番目まで、すなわち全体として1番目のレコードのみ差し込む、という設定にしています。

これで準備が整いました。

Executeメソッドの実行

いよいよ実行です。

' 差し込み実行
Call mm.Execute( _
    Pause:=True _
)

名前付き引数PauseTrueを渡しています。

この引数Pauseは、コチラによると、

True for Microsoft Word pause and display a troubleshooting dialog box if a mail merge error is found. False to report errors in a new document.

とのことです。

Trueにしておくと、差し込み時にエラーが発生したときに一時停止(Pause)してダイアログボックスを表示する、とのことなのでTrueにしておきました。

今回は、比較的小規模なデータを差し込み、実行後すぐに処理が終わる想定なので、エラーが出たときは止まってくれた方がありがたいでしょう。

逆に、大量のレコードを処理するような場合は、いちいち止まられると困るので、Falseにすることもあるかもしれません。(どんな場面か、いまいち想像がつきませんが。)

いざ、実行

では、リスト3を実行します。

次のような処理を行うはずです。

  • データを差し込んだ新規文書を作成する、という設定にする
  • データがないときは、差し込みフィールドだけの段落は削除する、と言う設定にする
  • 1番目のレコードをアクティブにして、1番目のレコードだけを差し込む設定にする
  • エラーが出たらダイアログボックスを出す設定にして差し込みを実行する

新規文書の1ページ目

このように、文書が表示されます。

ウィンドウのタイトルが「定型書簡1」になっているところがポイントです。

まだ保存されていない文書が、アクティブな状態になって表示されている、ということです。

これは、

Executeメソッドによって作成された文書(Documentオブジェクト)をActiveDocumentでつかまえることができる

ことを意味します。

新規文書の2ページ目

新しくできた文書の2ページ目です。

ちゃんと1番目のレコードのPhraseカラムの値が差し込まれています。

おわりに

これで、1件分のレコードを差し込んで新規文書を作成することができるようになりました。

作成した文書は、ApplicationオブジェクトのActiveDocumentプロパティを叩けば捕まえることができるので、

  • 作成直後の文書に必要な加工を施す
  • 名前を付けて保存する
  • レコードの件数分ループする

ことによって、目的を果たすことができます。

関連記事

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com

迷わず押せよ 押せばわかる

【連載】差し込み印刷のレコードごとにドキュメントを作成するマクロの解説(第2回)

第2回 差し込み印刷用文書と差し込みデータの準備

前回

akashi-keirin.hatenablog.com

の続きです。

差し込み印刷用文書と、文書に差し込むデータを準備し、差し込み印刷の設定を行います。

目次

差し込み印刷用文書の準備

「Word マクロ有効文書(*.docm)」形式の文書を作成する

まずは、差し込み印刷用文書を準備します。

あとでVBAのコードを仕込むことになるので、当然保存形式は「Word マクロ有効文書(*.docm)」です。

「Word マクロ有効文書(*.docm)」で保存

画像では、sample\差し込み印刷というフォルダの中にsample.docmという文書を作成しています。

1ページ目にコマンドボタンを配置する

まずは、文書の1ページ目にマクロ起動用のコマンドボタンを配置します。

前提として「開発」タブが表示されていなくてはいけません。

「開発」タブが非表示になっている人は、「ファイル」タブの「オプション」で表示させておきましょう。

「開発」タブの表示のさせ方をご存じない方は、「Word 開発タブ」あたりのキーワードでググってやればたちどころに解決すると思います。

では、コマンドボタンを追加していきましょう。

コマンド ボタンの追加

以前のバージョンのツール

「開発」タブ、「コントロール」グループの「以前のバージョンのツール」アイコンをクリックします。

コマンド ボタン(Active X コントロール)

「コマンド ボタン(Active X コントロール)」アイコンをクリックします。

デザイン モード

文書のカーソル位置(insertion point)にコマンド ボタン(このような要素を「コントロール(controle)」と呼びます。)が追加されました。

ここで、「コントロール」グループのところで「デザイン モード」のところがオンになっていることに注意してください。

コマンド ボタンのテキスト編集

オブジェクト→編集

コマンド ボタンを右クリックし、「オブジェクト」→「編集」の順にクリックします。

これで、コマンド ボタンに表示されるテキストを編集することができます。

ちなみに、右クリックが効くのは「デザイン モード」がオンのときだけです。

テキスト入力

このコマンドボタンにマクロを登録する、という設定は後ほど行います。

Excelだと非常に簡単な操作ですが、Wordの場合は少し事情が異なります。

ページ区切り挿入

1ページ目には、コマンド ボタンだけ置いておけば良いので、Ctrl + Enterでページ区切りを入れておきましょう。

2ページ目に差し込み文書の本体を作成する

では、差し込み文書の本体を入力しましょう。

2ページ目

……といっても、画像のように入力しているだけです。

今回は、「」の中にデータを差し込む仕様なので、ひとまず「」だけ入力しておきます。

この後、差し込み用データを作成し、差し込み用文書(=現在作成中のsample.docm)と差し込み用データファイルを接続してから、「」の中に〝差し込みフィールド〟(=データを闘魂注入するための場所)を設定することになります。

これで、一旦Word側の準備は一段落です。

差し込みデータの準備

差し込みデータ用Excelファイルの作成

こんどは、Word文書に差し込むためのデータを用意します。

差し込みデータファイルはどこに保存しても良いのですが、今回は差し込み文書(sample.docm)と同じフォルダに置くこととします。

Excelファイル新規作成

ファイル名は、別に何でも良いのですが、画像では、data-source.xlsxとしています。

データ入力

差し込み用データ作成

今回は、3件だけデータ(笑)を入力しています。

シート名はデフォルトの「Sheet1」のままでも良いのですが、画像では「src-data」としています。

単に差し込み印刷用文書(sanple.docm)の「」に闘魂注入するだけなら1列だけで良いのですが、出来上がった差し込み後の文書のファイル名を連番にするために「ID」という列を作成しています。

これで、差し込みデータもできました。上書き保存してdata-source.xlsxを閉じておきましょう。

次は、差し込み印刷用文書(sample.docx)と差し込みデータ(data-source.xlsxsrc-dataシートに作成した表)とを接続し、差し込みデータを闘魂注入するための〝差し込みフィールド〟を差し込み印刷用文書(sample.docm)に設定します。

差し込み印刷の設定

再度、差し込み印刷用文書(sample.docm)に戻ります。

差し込み印刷用文書と差し込みデータの接続

まず、差し込み印刷用文書(sample.docm)と差し込みデータ(data-source.xlsxsrc-dataシートに作成した表)を接続します。

既存のリスト

「差し込み文書」タブ、「差し込み印刷の開始」グループにある「宛先の選択」アイコン→「既存のリストを使用」の順にクリックします。

今回のプロジェクトの場合、差し込み用データ(のリスト)、すなわちdata-source.xlsxsrc-dataシートに作成した表はに作成して在しているので、「既存のリスト」を選択するわけです。

「宛先」ということばが出てくるのは、そもそもこの機能が葉書や封書の宛先部分の差し込みのための機能だからなのでしょう。

さて、「既存のリスト」をクリックすると、

謎のフォルダ

このように、いきなりわけのわからないフォルダからファイルを選択するよう促されます。

よく見ると、My Data Sourcesというフォルダ名なので、Officeの中の人的には「データソースはここに保存してね!」ということなのでしょう。

ただ、今回のプロジェクトでは、差し込み印刷用文書(sample.docm)と同じフォルダに差し込みデータ用Excelファイル(data-source.xlsx)を保存しているのですから、

フォルダ選択

慌てず騒がず...\sample\差し込み印刷フォルダに移動して、data-source.xlsxを選択し、「開く」をクリックしましょう。

すると、裏で差し込み印刷用文書(sample.docm)と差し込みデータ用Excelファイル(data-source.xlsx)が接続され、

テーブル選択

こんどは、差し込みデータ用Excelファイルのどこにデータがあるのか、指定するよう促されます。

ダイアログボックスのタイトルが「テーブルの選択」となっています。

テーブルとは〝表〟のことです。

差し込みデータ用Excelファイル(data-source.xlsx)では、「src-data」シートに表=テーブルの形式でデータ(笑)を作成している(参考)ので、「src-data$」を選択し、「OK」をクリックします。

先に作成した表では、先頭行を項目ラベルにしていたので、「先頭行をタイトル行として使用する」にチェックを入れてあります。(デフォルトでチェックが入っています。)

これで、差し込み印刷用文書と差し込みデータの接続は完了です。

文章入力とフィールドの挿入

さきほどまでグレーアウトされていた「文章入力とフィールドの挿入」グループのアイコンの多くがアクティブ化されています。

文書とデータソースとの接続が確立したため、これらの機能が使用可能になった、ということです。

差し込みフィールドの挿入

では、文書内にデータ(笑)を差し込む場所、すなわち差し込みフィールドを挿入します。

差し込みフィールドの挿入

データ(笑)を差し込みたい箇所にカーソルを置いて、「差し込み文書」タブの「差し込みフィールドの挿入」をクリックします。

「Phrase」を選択

すると、差し込みデータ用テーブル(表)の列(カラム column)のリストが展開するので、差し込みたいデータ(笑)の列名を選択します。

今回のプロジェクトでは、「Phrase」列のデータ(笑)を「」の中に差し込みたいので、「Phrase」を選択します。

差し込みフィールド

このように、差し込みフィールドが「」の中に挿入されました。

ちなみに、「文章入力とフィールドの挿入」グループの「結果のプレビュー」をクリックしてオンにすると、

結果のプレビュー

このように、データ(笑)を差し込んだ結果をプレビューすることができます。

画像は1つ目のレコードを表示しています。

差し込み結果のプレビュー

このように、他のレコードを差し込んだときの結果をプレビューすることができます。

実務で差し込み印刷機能を使う場合、差し込むデータの文字数によっては、レイアウトが崩れることがあるので、この機能を使って事前に確認しておくと良いでしょう。

これで差し込み印刷の設定は完了です。上書き保存をしておきましょう。

保存用フォルダの準備

最後に、データ(笑)を差し込んで新たに生まれた文書を保存するためのフォルダを作っておきます。

保存用フォルダの作成

フォルダ名は何でも良いのですが、画像では「★作成した文書」としています。

おわりに

これで準備は完了です。時は来た

次回はいよいよマクロの解説です。

関連記事

akashi-keirin.hatenablog.com

 

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com

補足1 マクロのソースコード

いちおう、マクロのソースコードを先に載っけておきます。

本記事と同じように設定していれば、sample.docmに標準モジュールを挿入し、次のコードをコピペしてやれば実行は可能です。

ただし、コマンド ボタンとの紐付けはまだなので、コマンド ボタンをクリックしても何も起こりません。動作確認の際は、直接マクロを実行してください。

リスト1
Option Explicit

Const FOLDER_NAME As String = "★作成した文書"    'フォルダ名を変えたらここを変えること。'

Public Sub ExportMailMergeDocuments()
    If Dir(ThisDocument.Path & "\" & FOLDER_NAME, vbDirectory) = "" Then
        Call MkDir(ThisDocument.Path & "\" & FOLDER_NAME)
        Call MsgBox( _
            Prompt:="作成済みファイルを保存するフォルダ「" & FOLDER_NAME & _
                    "」を、このファイルのあるディレクトリに作成しました。", _
            Buttons:=vbInformation, _
            Title:="お知らせ" _
        )
    End If
    Dim folderPath As String
    folderPath = ThisDocument.Path & "\" & FOLDER_NAME & "\"
    Dim srcDoc As Document
    Dim newDoc As Document
    Set srcDoc = ThisDocument
  
    On Error GoTo HandleError

    With srcDoc.MailMerge
        Dim maxRec As Long
        maxRec = .DataSource.RecordCount
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        Dim i As Long
        For i = 1 To maxRec
            With .DataSource
                .ActiveRecord = i
                .FirstRecord = i
                .LastRecord = i
            End With
            Call .Execute(Pause:=True)
            DoEvents
            Set newDoc = ActiveDocument
            Dim tgtFileName As String
            tgtFileName = "諸葛亮曰く_" & Format(.DataSource.DataFields("ID").Value, "00")
            If tgtFileName <> "" Then
                With newDoc
                    ' 文書末尾の余分なセクション区切りを削除
                    Dim lastSection As Section
                    Set lastSection = .Sections(.Sections.Count)
                    If lastSection.Range.Start = .Content.End - 1 Then
                        Call lastSection.Range.Previous(Unit:=wdCharacter, Count:=1).Delete
                    End If
                    ' 1ページ目を削除
                    Call newDoc.Range(0, 0).Select
                    Call newDoc.Bookmarks("\Page").Range.Delete
                    Call newDoc.SaveAs( _
                                    FileName:=folderPath & tgtFileName & ".docx", _
                                    fileformat:=wdFormatXMLDocument, _
                                    addtorecentfiles:=False)
                    Call newDoc.Close(SaveChanges:=False)
                End With
            End If
            DoEvents
        Next
    End With
    Set srcDoc = Nothing
    Set newDoc = Nothing
Exit Sub

HandleError:
    Call MsgBox( _
        Prompt:="エラーが発生しました。差込設定を見直すなど、設定を再確認してください。", _
        Buttons:=vbExclamation, _
        Title:="エラー!" _
    )
End Sub

補足2 差し込み印刷用文書オープン時のアラートについて

差し込み印刷の設定を施したあと、文書(今回の場合sample.docm)を再度開こうとすると、

文書オープン時のアラート

このようなアラートが表示されます。

曰く、

この文書を開くと、次のSQLコマンドが実行されます。

SELECT * FROM `'src-data$'`

データベースからのデータが、文書に挿入されます。続行しますか?

これは、次のようなことを言っています。

この文書を開くと、次のSQLコマンドが実行されます。

SQL」とは、Structured Query Languageの略で、データベースに命令を出すための言語のことです。

今回のプロジェクトでは、既にWordの文書(sample.docm)にデータベース(もどき)であるExcelファイル(source-data.xlsx)を接続しているので、Wordが

この文書に接続されているデータベース(もどき)に命令を出していいっすかね?

と確認している、というわけです。

SELECT * FROM `'src-data$'`

SELECT * FROM `'src-data$'`

これが、SQLの命令文です。

'src-data$'という名前の表(テーブル)から、全部の列(*)のデータを取り出しなさい。

と言っています。

データベースからのデータが、文書に挿入されます。続行しますか?

これは、

文書オープン時に、接続されているデータベース(もどき)であるExcelファイル(data-source.xlsx)にSQLの命令を出し、テーブル(「src-data」シートの表)からデータを取り出して文書に挿入するよ。いいかい?

と言っています。

ここで「はい」をクリックすると、Excelから取り出したデータが闘魂注入された状態で文書が開かれるので、差し込み印刷機能が使える、というわけです。

【連載】差し込み印刷のレコードごとにドキュメントを作成するマクロの解説(第1回)

当ブログでは比較的アクセス数の多い

akashi-keirin.hatenablog.com

について、改めて詳しく解説しようと思います。

第1回 完成品の仕様

まず、完成品の仕様について紹介しておきます。

およそ以下のような仕様です。

目次

1ページ目に実行ボタンがある

文書1ページ目のコマンドボタン

差し込み印刷のもとになる文書の1ページ目に、画像のようにコマンドボタンを配置します。

このボタンをクリックすることによって、マクロを実行します。

データを差し込んで新しいドキュメント(ファイル)を作成した後、1ページ目を削除してから保存するという動作にします。

画像では、編集画面の表示倍率を上げているせいで、ボタンのテキストがズレータになっています。

編集画面の表示倍率を100 %にすると正常に表示されます。

表示倍率を100%にした

なお、コチラの情報によると、ボタンのテキストを半角にすると正常に表示される、とのことですが、当方のWord2019では

やっぱりズレータ

ダメでした。うそつき。

どうにも気持ちが悪いのですが、〝仕様〟と割り切るほかないでしょう。

2ページ目以降が本体

文書の本体は2ページ目以降に作成します。

文書の本体

画像の<<Phrase>>のところに差し込み用のデータが挿入されます。

自動でファイル名を付けて保存する

コマンドボタンをクリックしてマクロを起動すると、

  • 新規文書作成
  • データを挿入
  • 1ページ目を削除
  • 名前を付けて保存

という動作を、差し込み用データのレコード数分繰り返して、ドキュメント(ファイル)を量産します。

保存用フォルダ内

それぞれの文書を開くと、

出来上がった文書

このとおり、それぞれデータが差し込まれた文書となっています。

おわりに

次回以降、元の文書の準備を始め、マクロを構成するVBAのコードについて詳しく解説します。

関連記事

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com