[[20130809221411]]　『入力した枚数を印刷したい』（aki）　ページの最後に飛ぶ

『入力した枚数を印刷したい』（aki）

こんばんわ
宜しくお願いします。

 以下のような表があります。

	【A】	【B】	【C】	【D】
1	通番	配送先　品目A	品目B
2	1	北海道	1	2
3	2	青森県		1
4	3	岩手県	2	
5	4	秋田県	4	3
6	5	山形県		
7	6	宮城県	1

 A列は通番、B列には配送先、C列には品目A、D列に品目Bを入力し、
配送したい数だけ、品目Aと品目Bに入力をしていきます。
ここでやりたいことは、品目Aと品目Bとそれぞれ印刷シートというものを作り
C列・D列に入力してあるところだけ、宛名に配送先を印刷し、
数字の分だけ印刷したいのです。
例えば、
1番は、品目Aと言うシートのA1に北海道と入力され1枚印刷、
つづいて、品目Bと言うシートのA1に北海道と入力され2枚印刷
されるようなイメージです。2番は品目Bのシートが1枚のみ印刷されるイメージです。

 +-------+ +-------+ +-------+   +-------+
 +品目A  + +品目B  + +品目B  +   +品目B  +
 +北海道 + +北海道 + +北海道 +   +青森県 + ・・・
 +       + +       + +       +   +       +
 +-------+ +-------+ +-------+   +-------+

 分かりづらいところが多々あると思いますが、何卒お願い申し上げます。
環境は、XP 2003です。
                                                   2013/08/09 22:42 aki

 具体的に印刷シートはどのようなレイアウトなのでしょうか。
 宛名シールに印刷できるようなシートになっているのでしょうか。

 であるとしたら、そのセル情報は提示された方が良いと思います。
 あるいは、１シート１葉なのですか？
 にしても、配送先と品目をどのセルに表示したらよいかの情報は欲しいです。
 (Mook)

Mookさま有難う御座います。

 また、分かりにくく申しわけありません。

 ＞具体的に印刷シートはどのようなレイアウトなのでしょうか。
A10からI50までは、文字や図が入力してあります。
印刷された印刷シートをダンボールに貼るイメージです。
A1に品目Aをあらかじめ入力しておくことも可能ですので、
B列の、配送先がA1やB1に入力されるのが理想です。

 ＞１シート１葉なのですか？
シートは、2枚です。品目A用と品目B用です。

 有難う御座います。宜しくお願いします。
                                                   2013/08/10 00:16 aki

 １シート１葉 というのは、１枚に一つの宛先があるかという意味なのですが、
 ２種類シートがあって、それぞれに差し込み印刷というイメージでしょうか。
 マクロの例です。
 ★ のところは実際のシート名に合わせてください。
 (Mook)

 Sub 送り先印刷()
    Dim ListWs As Worksheet
    Set ListWs = Worksheets("リストシート")  '// ★

    Dim r As Long
    Dim lastRow As Long
    lastRow = ListWs.Cells(Rows.Count, "A").End(xlUp).Row
    For r = 2 To lastRow
        If ListWs.Cells(r, "C").Value > 0 Then
            With Worksheets("印刷品目A") '// ★
                .Range("B2").Value = ListWs.Cells(r, "B").Value  '// ☆ 配送先記載位置
                .PrintOut copies:=ListWs.Cells(r, "C").Value
            End With
        End If

        If ListWs.Cells(r, "D").Value > 0 Then
            With Worksheets("印刷品目B") '// ★
                .Range("B2").Value = ListWs.Cells(r, "B").Value　'// ☆ 配送先記載位置
                .PrintOut copies:=ListWs.Cells(r, "D").Value
            End With
        End If
    Next
 End Sub

Mookさま　ありがとうございます

 検証させていただきます
御礼が遅くなり申し訳ありません
                                                   2013/08/10 23:50 aki

Mookさま　ありがとうございます

 シート名を、リストシート、印刷品目A、印刷品目Bとしてみました
C10とC20に1という数字を入れたところ
 → .PrintOut copies:=ListWs.Cells(r, "C").Value
が黄色くなりました。
もう少し検証してみます。
                                                   2013/08/11 00：40 aki

 ウーン、エラーのときのrは何でしょうか？
 一枚も印刷が出ない状態ですか？

 水曜までEXCELのマクロは試せないので、それまで他の方のフォローに期待です> <。
 (Mook)

mookさま

 有難う御座います
1枚も出ない状態です
印刷品目AのB2に、文字は入りました
自分もこれから模索します。
お忙しいなか、本当に有難うございます！
                                                   2013/08/11 13：57 aki

mookさま

 結果からお話をさせていただけると出来ました。
自分の情報公開不足でした。誠に申し訳ありません。
C・D列は、直接入力するわけではなく数式を入れておりました。
結果として、
If ListWs.Cells(r, "C").Value > 0 Then
　　　　　　　　↓
If ListWs.Cells(r, "C").Value <> "" Then
としたら出来ました。
有難う御座いました。
 　　　　　　　　　　　　　　　　　　　　　　　　2013/08/12 14：07 aki

mookさま

 申し訳ありません。
もう少しご教示いただけないでしょうか？
例えば
1枚印刷のときには、　1/1 
5枚印刷のときには、1/5 2/5 3/5 4/5 5/5
というように印刷することって可能ですか？
宜しくお願いします。
イメージとしては、こんな感じでセルに入れる？
 Sub カウントアップ_シンプル()
        For i = 1 To 5
                Range("a1") = i
                   'ActiveWindow.SelectedSheets.PrintOut Copies:=1
        Next i
 End Sub
自分の限界はこのあたりまでです。すいません。
 　　　　　　　　　　　　　　　　　　　　　　　　2013/08/12 20：07 aki

 今手元にEXCELがないのでブラインドコーディングですが、こういうことでしょうか。
 Sub 送り先印刷()
    Dim ListWs As Worksheet
    Set ListWs = Worksheets("リストシート")  '// ★
    Dim r As Long, i as Long
    Dim lastRow As Long
    lastRow = ListWs.Cells(Rows.Count, "A").End(xlUp).Row
    For r = 2 To lastRow
        If isNumeric(ListWs.Cells(r, "C").Value) = True And ListWs.Cells(r, "C").Value > 0 Then
            With Worksheets("印刷品目A") '// ★
                  For i=1 to ListWs.Cells(r, "C").Value
                        .Range("A1").Value = i & "/" & ListWs.Cells(r, "C").Value 
                        .Range("B2").Value = ListWs.Cells(r, "B").Value  '// ☆ 配送先記載位置
                        .PrintOut
                   Next
            End With
        End If
        If isNumeric(ListWs.Cells(r, "D").Value) = True And ListWs.Cells(r, "D").Value > 0 Then
            With Worksheets("印刷品目B") '// ★
                  For i=1 to ListWs.Cells(r, "D").Value
                        .Range("A1").Value = i & "/" & ListWs.Cells(r, "D").Value 
                        .Range("B2").Value = ListWs.Cells(r, "B").Value  '// ☆ 配送先記載位置
                        .PrintOut
                   Next
            End With
        End If
    Next
 End Sub
 (Mook)

 EXCEL で試してみました。
 同じ処理を繰り返しているのでプロシージャをまとめてみました。
 処理は上のと同じだと思いますが、とりあえず改訂版です。
 (Mook)

 Sub 送り先印刷()
    Dim ListWs As Worksheet
    Set ListWs = Worksheets("リストシート")  '// ★

    Dim r As Long
    For r = 2 To ListWs.Cells(Rows.Count, "A").End(xlUp).Row
        宛名印刷 Worksheets("印刷品目A"), ListWs.Cells(r, "B").Value, ListWs.Cells(r, "C").Value
        宛名印刷 Worksheets("印刷品目B"), ListWs.Cells(r, "B").Value, ListWs.Cells(r, "D").Value
    Next
 End Sub

 Sub 宛名印刷(印刷シート As Worksheet, 宛先 As String, 印刷枚数 As Long)
    Dim i As Long
    If IsNumeric(印刷枚数) = True And 印刷枚数 > 0 Then
        With 印刷シート
            .Range("B2").Value = 宛先
            For i = 1 To 印刷枚数
                  .Range("A1").Value = "'" & i & "/" & 印刷枚数
                  .PrintOut
             Next
        End With
    End If
 End Sub

Mookさま

 新しい記述有難う御座いました。
本当に感謝いたします。
この記述も施工させていただきます。
Mookさまには簡単なことなんですね。

 .Range("A1").Value = i & "/" & ListWs.Cells(r, "C").Value 
が、1月0日に表記がなってしまったため
.Range("A1").NumberFormatLocal = "@"
.Range("A1").Value = i & "/" & ListWs.Cells(r, "C").Value 
としたら思い通りの表記になりました。

 本当にお付き合いして頂き有難う御座います。
少しずつ出来るように精進したいと思います。
それでは失礼します。
  　　　　　　　　　　　　　　　　　　　　　　　　2013/08/15 01:50 aki

 日付になってしまうのを文字列対応で回避されたのは良かったと思います。
 後半のコードは ' をつけて日付になるのを避けましたが、文字列設定したほうが
 スマートな気がします。

 毎回設定する必要も無いので、処理の最初で行うか、マクロでなくとも一度文字列に
 書式設定しておけばそれでも良いかもしれません。

 毎回設定しても、結果は変わりませんが。
 (Mook)

mookさま

 ありがとうございました

 もうひとつ教えて下さい
数字が全く入っていない場合には、マクロを実施しても無反応ですが
何も入力してない状態で、マクロを実施したら
”数字が入力されてません”のようなメッセージで出すことは可能ですか？
  　　　　　　　　　　　　　　　　　　　　　　　　2013/08/17 12:35 aki

 For の前に確認処理を入れたらどうでしょうか。

    Dim lastRow As Long
    lastRow = ListWs.Cells(Rows.Count, "A").End(xlUp).Row

    If Application.Sum(ListWs.Range(ListWs.Cells(2, "C"), ListWs.Cells(lastRow, "D"))) = 0 Then
        MsgBox "数字が入力されてません"
        Exit Sub
    End If
    Dim r As Long
    For r = 2 To lastRow
　　　：
　　　：
 (Mook)

mookさま

 本当にありがとうございます
足した数字が０になるという概念はあったのですが
このようなことは理解できませんでした。

 ＞For の前に確認処理を入れたらどうでしょうか。
これが全く分かりませんでした。
自分は、後者の構文が理解しきれず、前者の構文をしようさせていただき

    Dim lastRow As Long
    lastRow = ListWs.Cells(Rows.Count, "A").End(xlUp).Row

     If Sheets("印刷品目A").Range("J53") = 0 Then ･･･J53が合計の為
             MsgBox "数字が入力されてません"
              End If
     If Sheets("印刷品目A").Range("K53") = 0 Then ･･･K53が合計の為
             MsgBox "数字が入力されてません"
              End If
     If Sheets("印刷品目A").Range("o63") = 0 Then ･･･O63が合計の為
             MsgBox "数字が入力されてません"
              End If
     If Sheets("印刷品目A").Range("P63") = 0 Then ･･･P63が合計の為
             MsgBox "数字が入力されてません"
              End If

    For r = 2 To lastRow

 としたところ、98×4回OKを押さないとポップアップが消えませんでした。
もっとスマートな書き方が沢山あると思うのですが・・・
ただこの書き方ですと、全てに入ってないと、０があるとポップアップが
出てしまいました。構文を理解していない証拠です。お恥ずかしい限りです。
本当に有難う御座いました。
  　　　　　　　　　　　　　　　　　　　　　　　　2013/08/17 23：15 aki

 ん、最終的にはうまくいったということでしょうか？

 上記のように For の前で判定していれば最大４回のメッセージだけですよね？
 If ・・・ Then
     MsgBox "xxxxxx"
     Exit Sub   '    <====   ここで Sub 処理を中断
 End If
 のようにしておけば、If の条件に当てはまった場合、MsgBox を表示後に処理が終了
 します。

 >  If Application.Sum(ListWs.Range(ListWs.Cells(2, "C"), ListWs.Cells(lastRow, "D"))) = 0 Then
 は C2:Dxxx (xxx は最終行) の合計が 0 だったら、という処理です。
 >  If Application.Sum(ListWs.Range("C2:D" & lastRow)) = 0 Then
 の方が少しはわかりやすいかな？ 
 (Mook)

mookさま

 本当にありがとうございます。

 ＞ん、最終的にはうまくいったということでしょうか？
↑
分かり辛くて申し訳ありません。最終的には上手くいきました。

 ＞上記のように For の前で判定していれば最大４回のメッセージだけですよね？
↑
はい仰るとおり、4回で済みました。最初は永遠に終わらないと思い、強制的にエクセルを閉じてました。

 ＞Exit Sub   '    <====   ここで Sub 処理を中断
 のようにしておけば、If の条件に当てはまった場合、MsgBox を表示後に処理が終了します。
↑
有難う御座います。そうなんですね。勉強になります。

 ＞If Application.Sum(ListWs.Range(ListWs.Cells(2, "C"), ListWs.Cells(lastRow, "D"))) = 0 Then
 は C2:Dxxx (xxx は最終行) の合計が 0 だったら、という処理です。
↑
正直分からないです。
Sum以降の違いが・・・
ListWs.Range(ListWs.Cells(2, "C")
ListWs.Cells(lastRow, "D")

 >  If Application.Sum(ListWs.Range("C2:D" & lastRow)) = 0 Then
 の方が少しはわかりやすいかな？ 
↑
学の無い自分は、こちらのほうが理解できました。

 お詫びが御座います。
     If Sheets("印刷品目A").Range("J53") = 0 Then ･･･J53が合計の為
             MsgBox "数字が入力されてません"
              End If
     If Sheets("印刷品目A").Range("K53") = 0 Then ･･･K53が合計の為
             MsgBox "数字が入力されてません"
              End If
     If Sheets("印刷品目A").Range("o63") = 0 Then ･･･O63が合計の為
             MsgBox "数字が入力されてません"
              End If
     If Sheets("印刷品目A").Range("P63") = 0 Then ･･･P63が合計の為
             MsgBox "数字が入力されてません"
              End If
 このように書きましたのは、もちろんmookさまに説明する必要があるわけ無いと思いますが
お詫びなので書かせて下さい。
範囲が2列では、自分に対応能力が無いと判断し、C・D列の1列ずつに反映させていました。
結果として、教えて頂きましたコードを
 If Application.Sum(ListWs.Range("C2:D108")) = 0 Then
とさせて頂きました。申し訳ありませんでした。
初めは、
　If Sum(Range("C8:D108")) = 0 Then
で始めたのですが、出来なかったので、Sum関数は使えないんだと勝手に解釈してました。
本当に細かくご親切に・ご丁寧に有難う御座います。
こんな自分にここまでのご尽力本当に恐縮で御座います。有難う御座います。
もちろんmookさまのように成れる訳がありませんが
今後も勉強させて頂ければ幸いです。
  　　　　　　　　　　　　　　　　　　　　　　　　2013/08/18 0:33 aki

コメント返信：

[ 一覧(最新更新順) ]

[[20130809221411]] 『入力した枚数を印刷したい』（aki） ページの最後に飛ぶ

[[20130809221411]]　『入力した枚数を印刷したい』（aki）　ページの最後に飛ぶ