顧客ごとに指定された枚数のシールを作成するには?

Question 80.7 Excel VBA Borad (掲示板)より Previous Next
現在Excelで連続伝票のフォームを作成しようとしています。

指定されたデータを指定された回数ずつ他のシートにコピーして印刷するには?」の項目で、やろうとしていることは同じなのですが、フォームの構造が6件分(2列×3段)で1ページ分です。(右下図のSheet2参照)

データの量が多くなることがありますので、データコピーと改ページを繰り返すことができるように改良しようと考えています。 お知恵を頂ければと思います。
                                  Sheet1

                     Sheet2
Answer   Copyright (C) 2012.4.1 永井善王
知りたいことは 2つですね。 さっそく、簡単な方から考えてみましょう。

1.改ページを繰り返すことができるようにしたい
どうしてもマクロでやりたい場合は、HPageBreaksプロパティで水平改ページ位置を設定することになるでしょう。 その方法を知りたい場合は下記ページにサンプルがありますから、そちらを見てください。
 
Macro 印刷 ・ 基本型 3) 改ページ
しかし、ご質問のような定型フォームにそれを使ってもメリットはないでしょうから、苦労することはないと思います。

では、どうすればよいかですが、Excelの一般機能の [印刷]-[ページ設定]-[余白]で、定型フォームに合うように上下左右の余白を設定しておきます。 そうしておくとExcelは自動的に改ページしてくれます。
具体的にはサンプルブックをダウンロードして、それで見てください。 ダウンロードの案内は、このページの末尾にあります。

2.データコピーのマクロ
あなたが見つけられたマクロ「
指定されたデータを指定された回数ずつ他のシートにコピーして印刷するには?」に
倣った手法で進みます。              Sheet3

A. 最初のマクロは下記のとおりで、各コードの機能はコメントを読んで理解していただきたいですが、大きい流れを説明しておきます。

このマクロは事前準備です。
Sheet1のデータを Sheet3 (右図:一時的な作業用) へ展開します。

Sheet1の2行目から順に下方向へ1行ずつ、その行のデータをコピーして、Sheet3へ貼り付けます。 貼り付ける回数は、Sheet1の I列の「印刷枚数」に入っている値です。 マクロは下記のようになります。
Private Sub Sheet1からSheet3へ印刷枚数分ずつコピーする()
    Worksheets("Sheet3").Cells.Clear            'Sheet3のすべてのセルをクリアする
    Worksheets("Sheet1").Activate               'Sheet1をアクティブにする
    下端行 = Range("A" & Rows.Count).End(xlUp).Row '(Sheet1の)下端行番号を取得する
    貼付行 = 1                                 '(Sheet3の)貼り付けるための行カウンター
    For 行 = 2 To 下端行                        '(Sheet1の)2行目から下端行まで繰り返す
        If Range("I" & 行).Value <> "" Then     '印刷枚数が空白でなければ
            Range("A" & 行 & ":H" & 行).Copy    'その行をコピーする
            For 枚数 = 1 To Range("I" & 行).Value '印刷枚数分繰り返す
               Worksheets("Sheet3").Range("A" & 貼付行).PasteSpecial Paste:=xlAll
                                                'Sheet3へ貼り付ける
               貼付行 = 貼付行 + 1             '(Sheet3の)貼り付け行カウンターをアップ
            Next
        End If
    Next
End Sub
B. 次に、Sheet3に展開されたデータを使って Sheet2へシールを作成します。
これら2つのシートのデータは 1:1 の関係になります。 つまり、Sheet3のデータは上図のとおり9件ですから、Sheet2に作成されるシールは9枚ということになります。
シールの作成順序は、最上段である1段目の左側→同右側→2段目の左側→同右側・・・5段目の左側となります。
マクロは下記のとおりです。下図 (Sheet2の先頭部分) と照らし合わせながら見てください。
      
Private Sub Sheet3のデータでSheet2へシールを作成する()
    Worksheets("Sheet2").Cells.Clear
    Worksheets("Sheet3").Activate
    下端行 = Range("A" & Rows.Count).End(xlUp).Row
    貼付行 = 0
    For データ行 = 1 To 下端行 Step 2
        With Worksheets("Sheet2")
            .Range("F" & 1 + 貼付行).Value = _
                "Tel " & Range("F" & データ行).Value '電話番号
            .Range("C" & 3 + 貼付行).Value = _
                Range("D" & データ行).Value    '住所1
            .Range("C" & 4 + 貼付行).Value = _
                Range("E" & データ行).Value    '住所2
            .Range("C" & 6 + 貼付行).Value = _
                Range("B" & データ行).Value    '名前
            .Range("D" & 10 + 貼付行).Value = _
                Range("H" & データ行).Value   '発送人
            If Range("A" & データ行 + 1).Value <> "" Then   '次のNO
                .Range("S" & 1 + 貼付行).Value = _
                    "Tel " & Range("F" & データ行 + 1).Value
                .Range("P" & 3 + 貼付行).Value = Range("D" & データ行 + 1).Value
                .Range("P" & 4 + 貼付行).Value = Range("E" & データ行 + 1).Value
                .Range("P" & 6 + 貼付行).Value = Range("B" & データ行 + 1).Value
                .Range("Q" & 10 + 貼付行).Value = Range("H" & データ行 + 1).Value
            End If
        End With
        貼付行 = 貼付行 + 39
    Next
End Sub
C. 最後に、上記 A.B. のマクロを一連にして実行するマクロを作成します。 このマクロには Sheet2を印刷するコードも組み込んでおきます。
Sheet1にボタンを作成しておいて、クリックすればマクロを実行するようにしておきたい場合は、このマクロをボタンに登録しておきます。
Sub 指定されたデータで指定された枚数分のシールを編集して印刷する()
    Sheet1からSheet3へ印刷枚数分ずつコピーする
    Sheet3のデータでSheet2へシールを作成する
    Worksheets("Sheet2").Activate
    ActiveSheet.PrintPreview
End Sub
以上になりますが、さっそく試されて、結果をご報告いただければ嬉しいです。
サンプルブックのダウンロードは ここをクリック  (YNxv99824_Copy.xls 102KB)

Excel VBA Macro