Wordを使って「宛て名ラベル」を印刷する
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　玄関へお回り下さい。
VBからWordの差し込み印刷機能を使って「宛て名ラベル」を印刷する　　（０９２）
動作確認：WindowsXP(SP2) VB6.0(SP6)/Word 2000/... 下記参照
　　　　　 "LabelPrint.doc"　は各自用意しておいて下さい。
Word を使って LabelPrint.doc の中で用紙の設定や印刷設定をして、データを差し込んだらよい状態で保存しておいて下さい。
又、住所録のデータはExcelで作成したものを使うようにすると後々便利かと思います
私のサンプルはファイルシステムコントロールを使って住所録ファイルを選択できるようにして
おりますが、ここでは長くなるのでその辺は省略してあります。

Option Explicit
Private Sub Command3_Click()
'★プロジェクト→参照設定でMicrosoft Word *.* Object Library に
'　チェックを入れておいて下さい。
'==================================================================
　 Dim wdApp　As Word.Application
　 Dim wdDoc　As Word.Document
　 Dim wdDoc1 As Word.Document
　 Set wdApp = CreateObject("Word.Application")
　 '差し込み印刷設定してあるWordのファイルを開く場合
　 Set wdDoc = wdApp.Documents.Open(App.Path & "\LabelPrint.doc")
　 Set wdDoc1 = wdApp.Documents(1)
　 Dim strMsg　　　As String
　 Dim AddressFile As String　　　'Excelの住所録ファイル名
　 Dim StrRcNo　　 As String　　　'印刷するレコードNo　start
　 Dim EndRcNo　　 As String　　　'印刷するレコードNo　End
　 'ファイル名取得(ファイルシステムコントロールより取得）

　 AddressFile = App.Path & "\Address.xls"
　 '住所録ファイルの差し替え
　 wdDoc.MailMerge.OpenDataSource Name:=AddressFile, _
　　　　　　LinkToSource:=True, Connection:="ワークシート全体"
　 'レコードNoの取得（各自設定して下さい）
　 StrRcNo = Trim$(Text1.Text)
　 EndRcNo = Trim$(Text2.Text)
　 'レコードNoのエラー処理及び初期設定
　 If Len(StrRcNo) = 0 Then
　　　StrRcNo = 1　'Default
　 Else
　　　StrRcNo = CLng(Text1.Text)
　　　If Err.Number Then
　　　　 StrRcNo = 1
　　　　 Err.Clear
　　　End If
　 End If
　 'レコードNoのエラー処理及び初期設定
　 If Len(EndRcNo) = 0 Then
　　　EndRcNo = -16　'転載禁止'Default　最後まで
　 Else
　　　EndRcNo = CLng(Text2.Text)
　　　If Err.Number Then
　　　　 EndRcNo = -16　'転載禁止
　　　　 Err.Clear
　　　End If
　 End If
　 '差し込み印刷機能のオプションの設定
　 With wdDoc.MailMerge　'転載禁止
　　　.Destination = wdSendToNewDocument　'差し込み文書の送り先を設定
　　　.SuppressBlankLines = False　　　　 'Trueの場合は空白行は印刷されない
　　　With .DataSource　　 '印刷するエクセルのシートのレコード範囲を設定
　　　　 .FirstRecord = CLng(StrRcNo)　　'項目行を除いた最初の行
　　　　 .LastRecord = CLng(EndRcNo)　　 '上記から１２行目まで
　　　End With　'転載禁止
　　　.Execute Pause:=True　'転載禁止　'指定されたデータの差し込みを実行します。
　 End With　'転載禁止
　 Set wdDoc1 = wdApp.Documents("定型書簡1")　'wdApp.Documents(1)
　 '文書を印刷　　 印刷処理が終了するまで待機'載禁止
　 wdDoc1.PrintOut Background:=False　'転載禁止

　 '印刷中のダイアログを非表示に設定
　 'wdDoc1.PrintOut Background:=True
　 'Do While wdApp.BackgroundPrintingStatus > 0
　 '
　 'Loop
'==================================================================
'Word の終了処理
　 '保存しないで終了転載禁止
　 wdApp.Quit SaveChanges:=wdDoNotSaveChanges
　 ' オブジェクトを解放します。
　 Set wdDoc1 = Nothing　'転載禁止
　 Set wdDoc = Nothing　'転載禁止
　 Set wdApp = Nothing　'転載禁止
End Sub


LabelPrint.doc ファイルは差込印刷設定がすでにしてあるWordの文書ファイルです
Address.xls ファイルは上記に合ったExcelの住所ファイルです。

従って、上記ファイルが別途用意できない方はこのサンプルは
お試しにならないで下さい
Excelで作成した住所録をよく使う宛て先だけ ６枚づつ ２社分 作ったりして色々保存しておいてVBから選択して印刷するようにしておけば結構使い道があるかと思います

Word 2002 や Word 2007 でも上記プログラムで一応動作はしますが、［先頭行をタイトル行として使用する］の 問合せや、Word の差込印刷の画面が表示されたりします。
Word のバージョンによって、差込印刷の機能が少し変ってきているようなので、御使用環境で確認され、ご希望通り印刷されるかは各自、確認して下さい。
別途、No.260(Word2002) No.401(CSVファイルを使用　）にも同様の差込印刷のプログラムがあります

又、下記サイトの資料等にも目を通しておいて下さい。

[WD2002] 差し込み印刷にて Excel ファイルを利用すると先頭行が項目名として設定される
http://support.microsoft.com/kb/814888/ja

[WD2003] Visual Basic で Word の差し込み印刷を自動化する方法
http://support.microsoft.com/default.aspx?scid=kb;ja;285332

[WD2003] [HOWTO] Visual Basic からオートメーションを使用して、Word の差し込み印刷で宛名ラベルを作成する方法
http://support.microsoft.com/default.aspx?scid=kb;ja;258512

Visual Basic から Microsoft Word の差し込み印刷をオートメーションで実行する方法
http://support.microsoft.com/default.aspx?scid=kb;ja;220607

SQL Server から取得した XML を使用してクライアント側で Word の差し込み印刷を実行する方法
http://support.microsoft.com/default.aspx?scid=kb;ja;285176

［Word 2002］ 差し込み印刷プログラムで Excel または Access をデータソースに指定すると [表の選択] ダイアログボックスが表示される
http://support.microsoft.com/default.aspx?scid=kb;ja;289830
'転載禁止

2002/05/18
2006/12/27


VBレスキュー(花ちゃん)
Visual Basic6.0　 VB6.0