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

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