この記事を新しいサイトに転記しました
----------------------------------------
セミナー受講生から、差し込み印刷に関する質問をいただきました。
例えば、100個のレコードを用いて差し込み印刷の「個々のドキュメントの編集」を実行する場合、1つのファイルにセクション区切りされた100個のレコードが作られます。
個別にファイルに保存するとなると、セクションごとに内容をコピペしなければならず大変な作業になります。
その対応策として、ネット上にはいろいろマクロが紹介されているようです。やっぱりこの手のことは必要ですね。
今回、私も1つ作ってみました。
-------------2016年6月23日追記-------------
実は、Wordの機能で同じことができるんですね。教えて!Helpdesk のこちらの記事をご覧ください。
Word差し込み印刷: 個別ファイルとして保存したい(1レコード1ファイルとして保存)
-------------追記終了-------------
▼このマクロでできること
差し込み印刷用のメイン文書に宛先のリスト(Excelファイルなど)が設定されている状態でマクロを実行します。
すると、このリストに掲載されたレコードをすべて差し込んだファイルが作成されます。
作成されるファイルは、フィールド名(又は、Excelファイルの列名)の”名前”に記載された値をファイル名とします。
メイン文書と同じフォルダにファイルが保存されます。
作成したファイルをすべて閉じます。
▼マクロの解説
赤文字部分で保存用のファイル名を設定しています。
青文字部分でファイルを閉じます。開いたままにする場合にはこの項目を削除してください。
紫文字部分を修正しました。(2014/03/09)
▼マクロ
Sub 差し込み印刷_レコード毎に別ファイルで保存()
Dim i As Integer
Dim iMax As Integer
Dim myName As String
Dim myMainDoc As Document
Dim myNewDoc As Document
Set myMainDoc = ActiveDocument
With myMainDoc.MailMerge
'レコード数の設定
.DataSource.ActiveRecord = wdLastRecord
iMax = .DataSource.ActiveRecord
'新規文書に書き出す
.Destination = wdSendToNewDocument
'空白の差し込みフィールドを印刷しない
.SuppressBlankLines = True
For i = 1 To iMax
'レコードの指定
.FirstRecord = i
.LastRecord = i
.ActiveRecord = i '追加しました。誤記を失礼しました。
End With
'文書作成(差し込みエラー時に停止)
.Execute Pause:=True
'ファイル名に用いる文字列(項目名を設定してください)
myName = .DataSource.DataFields("名前").Value
'新規文書に名前をつけて保存
Set myNewDoc = ActiveDocument
If myName <> "" Then
myNewDoc.SaveAs FileName:=myMainDoc.Path & "\" & _
myName & ".doc", _
FileFormat:=wdFormatDocument, _
AddToRecentFiles:=False
myNewDoc.Close
End If
DoEvents
Next i
End With
Set myMainDoc = Nothing
Set myNewDoc = Nothing
End Sub
▼関連記事
Word差し込み印刷: 個別ファイルとして保存したい(1レコード1ファイルとして保存) 外部記事