Excel97で作ったデータベースをもとに、宛名シートを作成します。
シートは、11×15の連帖シートとします
【サンプル1】
- 印刷用のシートを一つ用意します。
- 封筒や葉書にちょうどよく印刷されるように、書式等を整える。
- データが格納されているシートから印字したいデータを、印刷用シートの任意のセル範囲にコピーする。
- 書式等を整えた場所から参照する。(2.ですでに設定しておく。)コピーと同時に、宛名データが指定セルに表示される。
- 印刷シートの印刷範囲を指定する。
- 印刷する。
- (3)から繰り返し。
Private Sub cmdPrint_Click()
Dim r1 As Long
With Worksheets("data")
.Activate
.Cells(1, 1).Activate
End With
If optP_kobetu.Value = True Then
If lstP_atena.Text = "" Then
MsgBox "印刷する宛名が選択されていません。" _
& Chr(13) & Chr(13) & "リストから選択して下さい。", _
vbOKOnly, "注意"
Else
r1 = lstP_atena.ListIndex
ActiveCell.Offset(r1, 0).Range("a1:f1").Select
Selection.Copy
With Worksheets("hagaki")
.Activate
.Cells(1, 10).Activate
End With
With ActiveSheet
.Paste
.PageSetup.PrintArea = "$a$1:$d$17"
End With
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1
ActiveSheet.PageSetup.PrintArea = ""
End If
ElseIf optP_all.Value = True Then
If ActiveCell.Value <> "" Then
Do
ActiveCell.Range("a1:f1").Select
Selection.Copy
Worksheets("hagaki").Activate
Cells(1, 10).Activate
With ActiveSheet
.Paste
.PageSetup.PrintArea = "$a$1:$d$17"
End With
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1
ActiveSheet.PageSetup.PrintArea = ""
Worksheets("data").Activate
ActiveCell.Offset(1, 0).Activate
Loop Until ActiveWindow.ActiveCell.Value = ""
End If
End If
End Sub
【サンプル2】
まず項目は、
ID番号
漢字氏名
郵便番号
住所
の4つが基本になります、これが法人相手だと
法人名
役職名
などが追加されることがあります。
データを4列なら4列に配列するステップとレイアウト(行の幅、左右位置、「様」の有無)の修正のステップの二段階で考えられたらどうでしょう。
レイアウトに関しては、マクロの自動登録で一旦登録して、それをループさせる方法がよいでしょう。
【サンプル3】
A列に通し番号(1から昇順)
B列に郵便番号
C列に住所
D列に氏名
を記したシートがあるとします。
まず、AからD列までのデータが入力されている範囲に「挿入」「名前」「定義」で仮に「範囲」と名前をつけます。
そしてどこかに印刷フォーム(例は同じシートとします)を作っておき、以下のように関数を記述します。
この場合は、セルf1をカウンターとして使います。
=VLOOKUP(f1,範囲,1)
=VLOOKUP(f1,範囲,2)
=VLOOKUP(f1,範囲,3)&" 様"
これで、f1に入力したセルの番号のデータが
郵便番号
住所
氏名 様
と入力されるはずです。
つまり、f1のセルに1をいれれば、1番の人のタックが、2をいれれば、2番の人のタックが入りますので、1を入れ再計算して印刷、2を入れ再計算して印刷・・・と続ければ、宛名印刷ができます。
以下のようにマクロを書けばOKです。
sub atena_print()
Dim i as integer
for i = 1 to 100 step 1 '100人の場合
Range("f1") = i
Application.MaxChange = 0.001 '以下3行は、再計算です。
ActiveWorkbook.PrecisionAsDisplayed = False
ActiveSheet.Calculate
ActiveWindow.SelectedSheets.PrintOut Copies:=1 '印刷
Next i
end sub
また、この場合は、一人づつのタックですが、もし、2名を並べたければ
=VLOOKUP(f1,範囲,1) =VLOOKUP(f1+1,範囲,1)
=VLOOKUP(f1,範囲,2) =VLOOKUP(f1+1,範囲,2)
=VLOOKUP(f1,範囲,3)&" 様" =VLOOKUP(f1+1,範囲,3)&" 様"
のように並べておき、マクロのstep1をstep2にすれば、2列が延々と並びます。