HOME > 即効テクニック > Excel VBA > シート操作関連のテクニック > エクセルから宛名シートへの印刷

即効テクニック
シート操作関連のテクニック

エクセルから宛名シートへの印刷

(Excel 97)
Excel97で作ったデータベースをもとに、宛名シートを作成します。
シートは、11×15の連帖シートとします

【サンプル1】

    

  1. 印刷用のシートを一つ用意します。
    2. 

  2. 封筒や葉書にちょうどよく印刷されるように、書式等を整える。
    3. 

  3. データが格納されているシートから印字したいデータを、印刷用シートの任意のセル範囲にコピーする。
    4. 

  4. 書式等を整えた場所から参照する。(2.ですでに設定しておく。)コピーと同時に、宛名データが指定セルに表示される。
    5. 

  5. 印刷シートの印刷範囲を指定する。
    6. 

  6. 印刷する。
    7. 

  7. (3)から繰り返し。
    8. 




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列が延々と並びます。
ビジネス統計スペシャリスト VBAエキスパート