[[20150411212615]]　『差込印刷』（初心者）　ページの最後に飛ぶ

『差込印刷』（初心者）

お世話になります。
差込についてご相談させてください。

?@シート・・・印刷用のレイアウト
A４を縦六分割してシールを印刷するようにしています。

?Aシート・・・印刷用のレイアウトに相対参照させている元データをかく格納します。
A列・・「ID」
B列・・「部品番号」
C列・・「名前」
D列・・「適要」
１行目は、上記ヘッダーです。
レイアウトが6分割ですのでA2からD7に６データ分の値を入れるセルがあります。

?Bシート・・・?AシートA2からD7に差し込むべきデータがあり、日々変わります。
作成したいVBAの内容は下記のとおりです。

シート?Bには、下記データがあります。
A列・・「ID」
B列・・「部品番号」
C列・・「名前」
D列・・「適要」

シート?AのセルA2からD7には６データ分しか差し込めません。
シート?Bの２行目からまず、６データ分をシート?Aへ差込、
印刷をしたら次の６データ分を差込、・・・
という風に６データごとにシート?Aへデータを差込、シート?@にてレイアウトを印刷ということを繰り返したいです。

どのように書いてよいか全くわからず相談させていただきました。
よろしくお願いします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

シート名が文字化けしてわかりませんが

 Sub test()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim r As Long
    Dim n As Long

    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    Set ws3 = Worksheets("Sheet3")

    r = ws1.ranage("A" & Rows.Count).End(xlUp).Row
    n = 0
    Do While r > n + 1
        ws2.Range("a2:D7").Value = ws1.Range("a2:D7").Offset(n).Value
        ws3.PrintOut
        n = n + 6
    Next

 End Sub

（マナ） 2015/04/11(土) 22:33

マナさん
ありがとうございます。
実行してみたところ、NEXTに対するFORがありませんとエラーになりました。

（初心者） 2015/04/12(日) 09:41

 下から失礼します。
 Next を Loop に変えてどうでしょうか。

（Mook） 2015/04/12(日) 09:52

Mookさん
ありがとうございます。
LOOPにしたら作動しました。
しかし、意図していたようにはなっていません。

私の説明が稚拙なので、うまく伝わっているか心配なのですが、

シート１は印刷するレイアウトでシート２のA2からD7から相対参照しています。
ただし、印刷用であり、相対参照しているセルは、
「A2からD7」とはセル位置は一緒ではありません。

シート３にデータが仮に18個あるとすると、（A1からD1はヘッダー）
A2からD19まであることになります。
やりたいことは、シート２のA2からD7の部分へシート３のデータを差込み、シート２のデータを相対参照しているシート１で印刷します。
6データ分をシート２へ差し込んで印刷、次の6行分のデータを差込、印刷、という流れになります。

作動したマクロが終わったところ、印刷がおそらくデータ分と思われるくらい沢山されてしまいました。
（初心者） 2015/04/12(日) 12:18

 Mookさんありがとうございます。
 回答前にコンパイルエラーくらいは確認しなきゃですね（反省）

 初心者さん
 これで試してください。

 Sub test2()
    Dim wsデータ As Worksheet, ws参照 As Worksheet, ws印刷 As Worksheet
    Dim r As Long
    Dim n As Long

    Set wsデータ = Worksheets("シート3") '全データ
    Set ws参照 = Worksheets("シート2")   '印刷データ（６件分）
    Set ws印刷 = Worksheets("シート1")   '印刷するシート

    r = wsデータ.Range("A" & Rows.Count).End(xlUp).Row
    n = 0
    Do While r > n + 1
        ws参照.Range("A2:D7").Value = wsデータ.Range("A2:D7").Offset(n).Value
        ws印刷.PrintOut Preview:=True
        n = n + 6
    Loop

 End Sub

（マナ） 2015/04/12(日) 13:45

マナさん
ありがとうございます！
やりたいことができました。

何から何まで申し訳ないのですが・・・
印刷レイアウトには、画像としてQRコードがございます。
最後のページを印刷するときにたとえば一番下の行にデータがない場合は、
前回に印刷したQRコードが残ってしまいます。

これだと不都合なので、下記、コードを一枚印刷するごとに実行させていたのですが、
どのように組み合わせればよいのかわかりません。

下記コードは、ネットで探してきた「マクロボタンを除く画像をシートより削除する」コードで単独で試してみたところ、きれいに作動しました。

重ねて恐縮ですが、ご確認いただければ幸いです。

Dim zu As Object
ThisWorkbook.Sheets("シート1").Select

    For Each zu In ActiveSheet.Shapes
       shname = zu.Name
       If InStr(1, shname, "Button", 1) = 0 Then
          zu.Delete
       End If
    Next
End Sub
（初心者） 2015/04/12(日) 19:37

＞一枚印刷するごとに実行させていた

 とりあえず最後の１枚が5データ以下のとき実行にしました。

 Sub test3()
    Dim wsデータ As Worksheet, ws参照 As Worksheet, ws印刷 As Worksheet
    Dim r As Long
    Dim n As Long

    Set wsデータ = Worksheets("シート3") '全データ
    Set ws参照 = Worksheets("シート2")   '印刷データ（６件分）
    Set ws印刷 = ActiveSheet             '印刷するシート

    r = wsデータ.Range("A" & Rows.Count).End(xlUp).Row
    n = 0
    Do While r > n + 1
        If r - n - 1 < 6 Then QRコードを削除する
        ws参照.Range("A2:D7").Value = wsデータ.Range("A2:D7").Offset(n).Value
        ws印刷.PrintOut Preview:=True
        n = n + 6
    Loop
 End Sub

 Sub QRコードを削除する()
    Dim zu As Shape
    Dim shname As String

    For Each zu In ActiveSheet.Shapes
       shname = zu.Name
       If InStr(1, shname, "Button", 1) = 0 Then
          zu.Delete
       End If
    Next

 End Sub

（マナ） 2015/04/12(日) 21:07

マナさん
ありがとうございます。
明日から会社で使えそうです！
感謝です！
（初心者） 2015/04/12(日) 21:44

コメント返信：

[ 一覧(最新更新順) ]

[[20150411212615]] 『差込印刷』（初心者） ページの最後に飛ぶ

[[20150411212615]]　『差込印刷』（初心者）　ページの最後に飛ぶ