[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『差し込み印刷』（龍）
VBAの初心者です。
以前、差し込み印刷につき、この学校に相談し、
ネットから下記のようなコードを探し出しました。
下記にて、運用に問題が出来ましたので、再度相談させてください。
下記のdataのシートには、1ヶ月分の注文データがすべて、記載されています。
注文書は、各注文番号ごとに分けて、印刷します。
注文番号のフォーマットは、全部で60アイテムが入るようになっていますが、
当然注文番号によっては、5アイテムとか10アイテムとかの注文書もあります。
各注文番号ごとにソートして、A列の一番上のセルに「１」を入れましたが、
たとえば、5アイテムしかない注文書の場合、抽出していない次の注文書の55個のアイテムのデータも差し込んで、印刷してしまいます。
下記、コードを加工して、DATAシートで抽出しているデータのみ印刷できるように
変えたいのですが、どなたかご教授いただければ、幸いです。
よろしくお願いいたします。
Sub printing()
Dim r As Range
If MsgBox("打印欄に 1 があるデータを印刷しますか？", _
vbQuestion + vbYesNo, "連続印刷") <> vbYes Then Exit Sub
With Worksheets("data")
For Each r In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
If r.Value = 1 Then
Worksheets("注文書").Range("A4:F5").Select
ActiveCell.FormulaR1C1 = ""
Worksheets("注文書").Range("B6:F7").Select
ActiveCell.FormulaR1C1 = ""
Worksheets("注文書").Range("G6:G7").Select
ActiveCell.FormulaR1C1 = ""
Worksheets("注文書").Range("O2:O3").Select
ActiveCell.FormulaR1C1 = ""
Worksheets("注文書").Range("A1:C2").Select
ActiveCell.FormulaR1C1 = ""
Worksheets("注文書").Rows("20:34").Select
Selection.ClearContents
Worksheets("注文書").Rows("54:68").Select
Selection.ClearContents
Worksheets("注文書").Rows("88:102").Select
Selection.ClearContents
Worksheets("注文書").Rows("122:136").Select
Selection.ClearContents
Worksheets("注文書").Range("A1").Select
Worksheets("注文書").Range("A1").Value = r.Offset(0, 2).Value
Worksheets("注文書").Range("A4").Value = r.Offset(0, 3).Value
Worksheets("注文書").Range("B6").Value = r.Offset(0, 57).Value
Worksheets("注文書").Range("G6").Value = r.Offset(0, 58).Value
Worksheets("注文書").Range("O2").Value = r.Offset(0, 52).Value
Worksheets("注文書").Range("B20:B34").Value = r.Offset(0, 9).Resize(15, 9).Value
Worksheets("注文書").Range("B54:B68").Value = r.Offset(15, 9).Resize(30, 9).Value
Worksheets("注文書").Range("B88:B102").Value = r.Offset(30, 9).Resize(45, 9).Value
Worksheets("注文書").Range("B122:B136").Value = r.Offset(45, 9).Resize(60, 9).Value
・
・
・
・
Worksheets("注文書").PrintOut
End If
Next r
End With
End Sub
EXCEL2010
windows7
条件によって印刷するということはコードで出来ていると思いますが、 一つの注文データは1行ではないのでしょうか。
注文書のB20以降へ代入している部分のコピー元が複数行にわたっているように見えますが、 データのレイアウトをもう少し詳細に説明した方が良いように思います。
ちなみにデータをクリアする部分は下記のようにも書けます。
Worksheets("注文書").Range("A4:F5,B6:F7,G6:G7,O2:O3,A1:C2").FormulaR1C1 = ""
Worksheets("注文書").Range("20:34,54:68,88:102,122:136").ClearContents
(Mook)
コメントおよびご教授をありがとうございます。
説明が乏しく、申し訳ありません。
注文書のB20以降へ代入している部分のコピー元が複数行にわたっているように 見えますが、 データのレイアウトをもう少し詳細に説明した方が良いように思います。 ⇒確かにコピー元は、複数行、あります。 上記にも申し上げましたが、差し込み式のシートは、全体で4枚あります。 1枚の注文書には、15行の差し込み部分があります。（つまり、15アイテム分です）
注文番号ごとに注文書を発行するのですが、 注文番号によっては、5アイテムしかなかったり、あるものは、 60アイテムあったりしま すので、 上限を60アイテムとして、フォーマットを作りました。（注文書にして4枚）
dataシートには、9月発注分のすべての情報が、データベースとして存在します。
このdataシートのA列に1を入力して、注文書を印刷します。
注文番号でソート抽出をして、その先頭行に１を入れたら、例えば5アイテムだけ だったら、1枚目の5行分だけを印刷したいと考えていましたが、6行目には、 ソートして抽出されていない次の注文番号のデータが差し込まれてしまいます。
注文番号ごとにコピペして、dataシートに貼り付け、印刷の準備をすることは、 出来ますが、作業が多くなり、ミスも起こりやすいので、出来れば、 差し込み印刷するのは、ソート抽出した部分だけに限るという設定に下記コードを 変更できないかと思い、ご相談させていただきました。
下記、が全体のコードです。 説明が未だ分かりにくいかもしれませんが、ご確認をお願いします。
また、注文書のシートでB20（注文書1枚目）、B54（注文書2枚目）、 B88（注文書3枚目）、B122（注文書4枚目）がそれぞれ「空欄」であった場合は、 その注文書のページは、印刷しないというコードを加えたいのですが・・・ 重ねてご教授をお願いします。
Sub printing()
Worksheets("注文書").Range("A4:F5,B6:F7,G6:G7,O2:O3,A1:C2").FormulaR1C1 = ""
Worksheets("注文書").Range("20:34,54:68,88:102,122:136").ClearContents
Dim r As Range
If MsgBox("印刷欄に 1 があるデータを印刷しますか？", _
vbQuestion + vbYesNo, "連続印刷") <> vbYes Then Exit Sub
With Worksheets("data")
For Each r In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
If r.Value = 1 Then
Worksheets("注文書").Range("A1").Value = r.Offset(0, 2).Value
Worksheets("注文書").Range("A4").Value = r.Offset(0, 3).Value
Worksheets("注文書").Range("B6").Value = r.Offset(0, 57).Value
Worksheets("注文書").Range("G6").Value = r.Offset(0, 58).Value
Worksheets("注文書").Range("O2").Value = r.Offset(0, 52).Value
Worksheets("注文書").Range("B20:B34").Value = r.Offset(0, 9).Resize(15, 9).Value
Worksheets("注文書").Range("B54:B68").Value = r.Offset(15, 9).Resize(30, 9).Value
Worksheets("注文書").Range("B88:B102").Value = r.Offset(30, 9).Resize(45, 9).Value
Worksheets("注文書").Range("B122:B136").Value = r.Offset(45, 9).Resize(60, 9).Value
Worksheets("注文書").Range("C20:C34").Value = r.Offset(0, 10).Resize(15, 10).Value
Worksheets("注文書").Range("C54:C68").Value = r.Offset(15, 10).Resize(30, 10).Value
Worksheets("注文書").Range("C88:C102").Value = r.Offset(30, 10).Resize(45, 10).Value
Worksheets("注文書").Range("C122:C136").Value = r.Offset(45, 10).Resize(60, 10).Value
Worksheets("注文書").Range("D20:D34").Value = r.Offset(0, 1).Resize(15, 1).Value
Worksheets("注文書").Range("D54:D68").Value = r.Offset(15, 1).Resize(30, 1).Value
Worksheets("注文書").Range("D88:D102").Value = r.Offset(30, 1).Resize(45, 1).Value
Worksheets("注文書").Range("D122:D136").Value = r.Offset(45, 1).Resize(60, 1).Value
Worksheets("注文書").Range("E20:E34").Value = r.Offset(0, 7).Resize(15, 7).Value
Worksheets("注文書").Range("E54:E68").Value = r.Offset(15, 7).Resize(30, 7).Value
Worksheets("注文書").Range("E88:E102").Value = r.Offset(30, 7).Resize(45, 7).Value
Worksheets("注文書").Range("E122:E136").Value = r.Offset(45, 7).Resize(60, 7).Value
Worksheets("注文書").Range("F20:F34").Value = r.Offset(0, 69).Resize(15, 69).Value
Worksheets("注文書").Range("F54:F68").Value = r.Offset(15, 69).Resize(30, 69).Value
Worksheets("注文書").Range("F88:F102").Value = r.Offset(30, 69).Resize(45, 69).Value
Worksheets("注文書").Range("F122:F136").Value = r.Offset(45, 69).Resize(60, 69).Value
Worksheets("注文書").Range("G20:G34").Value = r.Offset(0, 8).Resize(15, 8).Value
Worksheets("注文書").Range("G54:G68").Value = r.Offset(15, 8).Resize(30, 8).Value
Worksheets("注文書").Range("G88:G102").Value = r.Offset(30, 8).Resize(45, 8).Value
Worksheets("注文書").Range("G122:G136").Value = r.Offset(45, 8).Resize(60, 8).Value
Worksheets("注文書").Range("H20:H34").Value = r.Offset(0, 12).Resize(15, 12).Value
Worksheets("注文書").Range("H54:H68").Value = r.Offset(15, 12).Resize(30, 12).Value
Worksheets("注文書").Range("H88:H102").Value = r.Offset(30, 12).Resize(45, 12).Value
Worksheets("注文書").Range("H122:H136").Value = r.Offset(45, 12).Resize(60, 12).Value
Worksheets("注文書").Range("I20:I34").Value = r.Offset(0, 11).Resize(15, 11).Value
Worksheets("注文書").Range("I54:I68").Value = r.Offset(15, 11).Resize(30, 11).Value
Worksheets("注文書").Range("I88:I102").Value = r.Offset(30, 11).Resize(45, 11).Value
Worksheets("注文書").Range("I122:I136").Value = r.Offset(45, 11).Resize(60, 11).Value
Worksheets("注文書").Range("J20:J34").Value = r.Offset(0, 24).Resize(15, 24).Value
Worksheets("注文書").Range("J54:J68").Value = r.Offset(15, 24).Resize(30, 24).Value
Worksheets("注文書").Range("J88:J102").Value = r.Offset(30, 24).Resize(45, 24).Value
Worksheets("注文書").Range("J122:J136").Value = r.Offset(45, 24).Resize(60, 24).Value
Worksheets("注文書").Range("K20:K34").Value = r.Offset(0, 25).Resize(15, 25).Value
Worksheets("注文書").Range("K54:K68").Value = r.Offset(15, 25).Resize(30, 25).Value
Worksheets("注文書").Range("K88:K102").Value = r.Offset(30, 25).Resize(45, 25).Value
Worksheets("注文書").Range("K122:K136").Value = r.Offset(45, 25).Resize(60, 25).Value
Worksheets("注文書").Range("L20:L34").Value = r.Offset(0, 29).Resize(15, 29).Value
Worksheets("注文書").Range("L54:L68").Value = r.Offset(15, 29).Resize(30, 29).Value
Worksheets("注文書").Range("L88:L102").Value = r.Offset(30, 29).Resize(45, 29).Value
Worksheets("注文書").Range("L122:L136").Value = r.Offset(45, 29).Resize(60, 29).Value
Worksheets("注文書").Range("L20:L34").Value = r.Offset(0, 29).Resize(15, 29).Value
Worksheets("注文書").Range("L54:L68").Value = r.Offset(15, 29).Resize(30, 29).Value
Worksheets("注文書").Range("L88:L102").Value = r.Offset(30, 29).Resize(45, 29).Value
Worksheets("注文書").Range("L122:L136").Value = r.Offset(45, 29).Resize(60, 29).Value
Worksheets("注文書").Range("M20:M34").Value = r.Offset(0, 68).Resize(15, 68).Value
Worksheets("注文書").Range("M54:M68").Value = r.Offset(15, 68).Resize(30, 68).Value
Worksheets("注文書").Range("M88:M102").Value = r.Offset(30, 68).Resize(45, 68).Value
Worksheets("注文書").Range("M122:M136").Value = r.Offset(45, 68).Resize(60, 68).Value
Worksheets("注文書").Range("N20:N34").Value = r.Offset(0, 50).Resize(15, 50).Value
Worksheets("注文書").Range("N54:N68").Value = r.Offset(15, 50).Resize(30, 50).Value
Worksheets("注文書").Range("N88:N102").Value = r.Offset(30, 50).Resize(45, 50).Value
Worksheets("注文書").Range("N122:N136").Value = r.Offset(45, 50).Resize(60, 50).Value
Worksheets("注文書").Range("O20:O34").Value = r.Offset(0, 38).Resize(15, 38).Value
Worksheets("注文書").Range("O54:O68").Value = r.Offset(15, 38).Resize(30, 38).Value
Worksheets("注文書").Range("O88:O102").Value = r.Offset(30, 38).Resize(45, 38).Value
Worksheets("注文書").Range("O122:O136").Value = r.Offset(45, 38).Resize(60, 38).Value
Worksheets("注文書").PrintOut
End If
Next r
End With
End Sub
（龍）
まず龍さんのシートを回答者は見えないということを理解してください。 1シートに4ページ分のレイアウトがあるということは上の説明でわかりましたが、 シートに入れるデータ元のデータ形式はどうなっているのでしょうか。
A列の１がどの範囲に影響するのか（その行だけなのか、その行以下〇行なのか） といったところが見えません。
また1シートに4ページ分のレイアウトを持っているようですが、 そもそも4つが同じ書式（ページ番号が違う程度）であるなら、一つの書式にして 差し込みにした方がシンプルになる気がします。
コードの例示はよいのですが、シート構成（特にデータシート）のサンプルを提示 いただくと、話が早いと思います。 (Mook)
コードで使用されている Offset と Resize の情報がおそらく正しくないので（少なくとも左右で大きさが異なる） 正確な情報を言葉で説明していただきたかったのですが、下記の前提でのコードです。
A 列に印刷したい情報に 1 がある。 A 列に 1 があった場合、そこから60行データがあり、15行ごとで１セットのデータとなっている 各15行の J 列にデータがあった場合、そのセットのデータを印刷シートに転記する
コード中の Array の中は、転記情報で J->B@15 は data シートの J列から15列（J：X） を注文書のB列から15列（B:P）へコピーする という意味です。 実際の目的に応じて修正してみてください。
多分に推測ですから、実際と異なるとは思いますが、これで上記の条件に記載した 内容を処理するコードになっていると思います。
異なる点があったら、状況が誰にでもわかるよう説明ください。 (Mook)
Sub Printing()
If MsgBox("印刷欄に 1 があるデータを印刷しますか？", _
vbQuestion + vbYesNo, "連続印刷") <> vbYes Then Exit Sub
Dim r As Range
Dim p As Long
Dim copyInfo
Dim copyInfoArray
Dim copyRows As Long
Dim copyCols As Long
With Worksheets("data")
For Each r In .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
' A 列が 1 のとき
If r.Value = 1 Then
' 注文書のクリア
Worksheets("注文書").Range("A4:F5,B6:F7,G6:G7,O2:O3,A1:C2").FormulaR1C1 = ""
Worksheets("注文書").Range("20:34,54:68,88:102,122:136").ClearContents
' 個別情報（？）の転記
Worksheets("注文書").Range("A1").Value = r.Offset(0, 2).Value
Worksheets("注文書").Range("A4").Value = r.Offset(0, 3).Value
Worksheets("注文書").Range("B6").Value = r.Offset(0, 57).Value
Worksheets("注文書").Range("G6").Value = r.Offset(0, 58).Value
Worksheets("注文書").Range("O2").Value = r.Offset(0, 52).Value
' アイテムごと（？）の転記
For p = 0 To 3
If r.Offset(p * 15, 9).Value = "" Then Exit For
For Each copyInfo In Array("J->B@15", "K->C@15", "B->D@15", "H->E@15", "BR->F@15", "I->G@15", "M->H@15", "L->I@15", "Y->J@15", "Z->K@15", "AD->L@15", "BQ->M@15", "AY->N@15", "AM->O@15")
'// CopyInfo := コピー元 -> コピー先 @ コピー列数
copyInfoArray = Split(Replace(copyInfo, "->", "@"), "@")
If InStr(copyInfoArray(2), "x") > 0 Then
copyRows = Split(copyInfoArray(2), "x")(0)
copyCols = Split(copyInfoArray(2), "x")(1)
Else
copyRows = copyInfoArray(2)
copyCols = 1
End If
Worksheets("注文書").Cells(20 + 34 * p, copyInfoArray(1)).Resize(copyRows, copyCols).Value _
= .Cells(r.Row + p * 15, copyInfoArray(0)).Resize(copyRows, copyCols).Value
Next
Next
Worksheets("注文書").PrintOut From:=1, To:=p
End If
Next
End With
End Sub
Resize に目を取られて状態を勘違いしていましたが、基本的に列単位の 処理だったでしょうか。
これにあわせて、 J->B@15 を data シートの J列から15列（Jx：Jx+14） を注文書のB列から15行（Bx:Bx+14）へコピーする というように変更しました。
使わないと思いますが、複数列コピーする場合は J->B@15x2 とすると、15行2列の範囲をコピーします。 (Mook)
＞コードで使用されている Offset と Resize の情報がおそらく正しくないので のご参考に（？ご確認済みかもしれませんが。）、前スレです。 [[20120824090810]] 『差し込み印刷の範囲の書き方の省略』（龍）
(HANA)
前スレの紹介ありがとうございました。 すでにお話が出ていたのですね。
そちらでお話を進めて理解まで進むことができていると良かったですね。 もうこちらも見ていないかな？ (Mook)
遅くなり、申し訳ありません。
すみません。
もう一度、内容を理解して、ご相談させていただきます。
（龍）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.