excel2000VBAで用紙の上半分部分のみ連続印刷する

質問

excel2000VBAでマクロを作成しています。
10人について数項目については同じですが、人によって請求項目が違い、請求項目がない人については、非表示にしたいです。
また前回の請求を参考に見ながら書き換え必要部分のみ入力作成します。
請求書の印刷は、Ａ4用紙5枚を使います。
各シートの、上半分（1/2）の部分が請求書になっていますので各シートの上半分部分を1枚目から10枚目まで連続で印刷します。
下記のコードは、シート2枚印刷すると、その横の列に
順に印刷するようにマクロ作成しました。つまり縦に2枚横5枚づつ計10枚印刷できます。
これでなんら印刷の不具合は生じません。
しかしながら、見るからに幼稚なコードで情けないです。これをマクロらしく、もしくは新しい別の方法をご教示ねがいたいのです。よろしくお願いします。

Sub 請求書一括印刷()
Application.ScreenUpdating = False
Sheets("A").Select
Range("B2:AB32").Select
Selection.Copy
Sheets("請求印刷 (2)").Select
Range("B1").Select
ActiveSheet.Paste
Sheets("A").Select
Application.CutCopyMode = False
Range("B2").Select

Sheets("B").Select
Range("B2:AB32").Select
Selection.Copy
Sheets("請求印刷 (2)").Select
Range("B34").Select
ActiveSheet.Paste
Sheets("B").Select
Application.CutCopyMode = False
Range("B2").Select

Sheets("C").Select
Range("B2:AB32").Select
Selection.Copy
Sheets("請求印刷 (2)").Select
Range("AD1").Select
ActiveSheet.Paste
Sheets("C").Select
Application.CutCopyMode = False
Range("B2").Select
　　以下つづく
Sheets("hyousi").Select

End Sub

回答No.4

Wendy02 · ベストアンサー

こんにちは。

回答のお礼の中で、規約違反されたので、私の掲示か、もしくは、このスレッド全体が近いうちに消されてしまう可能性があります。削除されて質問が解決していなかった時は、できましたら、続きを再掲示してください。
(直接、ご質問者と連絡が取れるような情報の掲示は禁止されています。そこだけ削除してとお願いしてもダメでした。）

私の方の、「コピー領域と貼り付け領域が違う」というのは、貼り付け側が、セル１つではなくて、複数のセルの領域になっている可能性があるのですが、分りません。

　Worksheets("請求印刷 (2)").Range("B65536").End(xlUp).PasteSpecial
では、そのようなエラーが出てくるとは考えられません。
ただ、状況からみて、イメージとまったく違いましたので、前回のでは役に立ちません。

それから、#3 imogasiさんの回答のお礼の「するとｎのところで「変数が定義されていません。」でとまってしまいました。悲しいかな変数の設定もできない程度なので・・・。」というのは、初歩的なことですから、分らなかったら、Dim n だけで結構です。

Option Explit の意味は、明示的に変数を宣言するということです。だから、それが入れていないものは、エラーが出ます。

たぶん、マクロは、こういうことではありませんか？ロール紙や連続用紙などを使っていたら、これではうまくいきませんが。

Sub TesSample()
　 Dim mySh As Variant
　 '請求書一括印刷
　 mySh = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
　 Worksheets(mySh).Select
　 Worksheets(mySh).PrintPreview
　 Worksheets("hyousi").Select
End Sub

'---------------------------------
Sub SettingMacro()
　'印刷設定用（一度だけでよいと思います）
　 Dim mySh As Variant
　 Dim i As Long
　 mySh = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
　 For i = LBound(mySh) To UBound(mySh)
　　　With Worksheets(mySh(i))
　　　.PageSetup.PrintArea = .Range("B2:AB32").Address
　　　'縦か横か分りませんが、以下は横です。
'　　　.PageSetup.Orientation = xlLandscape
　　　.PageSetup.BlackAndWhite = True
　　　End With
　 Next
End Sub

本格的には、全体を直したほうがよいですね。表示・入力部分とデータ部分との保存は別々にします。今、私もこれは本格的に勉強しようと思っています。本来は、Accessのほうが簡単かもしれません。たぶん、サンプルは探せば見つかるかと思いますし、本もいくつか出ています。自力では、ちょっと大変かもしれません。

お礼

Wendy02様　突然の寝耳に水でした。もうしわけありません。自分のデータをＵＰしたことが、規約違反とは夢にも思ってなかったです。ご迷惑かけてすいませんでした。あなた様の文章をよくよんで勉強します。本当に痒いところまで手の届くように教えていただき感謝しております。また今後ともよろしくお願いします。お言葉のとおり一旦このスレッドを閉鎖いたします。

回答No.3

imogasi

先ほどの質問に回答を入れた者です。
そのとき次のようなのを作ってテストしましたが、私には本当のデータがないので、やってみてください。短くすることを心がけました。
Sub 請求書一括印刷()
Application.ScreenUpdating = False
n = Array("A", "B", "C", "D", "E")
C = Array("B1", "B34", "AD1", "AD34", "B2")
For i = 0 To UBound(n)
Sheets(n(i)).Activate
Sheets(n(i)).Range("B2:AB32").Select
Selection.Copy
Sheets("請求印刷 (2)").Activate
Sheets("請求印刷 (2)").Range(C(i)).Select
ActiveSheet.Paste
'-----
Sheets(n(i)).Select
Application.CutCopyMode = False
Range("B2").Select
Next i
Application.ScreenUpdating = True
Exit Sub
End Sub
２つのArrayのA,B・・は実際のシート名で置き換えし10個補充。
後者は実際の範囲を１０個、列挙してください。
ただし前問の表示・非表示の問題は別にして。

補足

今試してみました。するとｎのところで「変数が定義されていません。」でとまってしまいました。悲しいかな変数の設定もできない程度なので・・・。

回答No.2

Wendy02

aitaineさん、こんばんは。Wendy02です。

No.1775862「Exel2000VBA非表示の行が印刷されてしまう」は、早く締めすぎましたね。
また、ご質問が出ると思っていました。前回の分で、私は、サンプルコードを用意していました。

＞しかしながら、見るからに幼稚なコードで情けないです。

それは、しょうがないと思います。

地道な勉強の積み重ねと、テクニックを増やしていくしかありません。こちらでサンプルをご用意しましたので、それを参照していただければよいのですが、一日で、誰にでも納得させられるようなコードが書けるようになるわけではありません。掲示板は、玉石混交です。一番良いのは、Office VBAのプロ級の人の書いたプロジェクトを垣間見ることですね。単体のプロシージャだけでは分りません。変数の使い方、プロシージャのまとめ方、モジュールの使い分けなどが覚えられます。

VBAを書くには、少し基本的な原則があります。
（今は、MSDNしか載っていません。本来は、Office プログラマーズガイドに「一般的な最適化方法」としてあったもので、今は、ほとんど知られなくなってしまいました。）

　なるべく、同じパターンのコードは繰り返さない。－ループを使う。For Each ...Nextがベスト。
　オブジェクト（シートやセル）のアクティブ化と選択(Select)は減らす。
　エラートラップ以外のGoto の使用は避ける。－構造化につとめる。
　変数で型の宣言する。－バリアント型変数の使用は減らす。
　オブジェクト型の変数で、領域を確保する。
　画面の更新は行わない－Application.ScreenUpdatingを使う

当面、こんな話があったなっていう程度で結構です。それは、必ずではありません。以下は、上記の原則からは、多少、足りない部分があります。

以下は、前回のご質問用に作ったものです。
'-------------------------------------------------

Option Explicit
Sub BillsTotalPrintProc()
　 '請求書一括印刷
　 Dim mySh As Variant
　 Dim i As Long
　 Application.ScreenUpdating = False
　 '請求印刷面のデータの削除
　 Worksheets("請求印刷 (2)").UsedRange.ClearContents
　 'シート名
　 mySh = Array("A", "B", "C", "D", "E", "F")
　 '開始
　 For i = LBound(mySh) To UBound(mySh)
　　　Worksheets(mySh(i)).Range("B2:AB32").SpecialCells(xlCellTypeVisible).Copy
　　　If i = 0 Then
　　　　 Worksheets("請求印刷 (2)").Range("B65536").End(xlUp).PasteSpecial
　　　　 Else
　　　　 Worksheets("請求印刷 (2)").Range("B65536").End(xlUp).Offset(1).PasteSpecial
　　　End If
　 Next
　 Worksheets("請求印刷 (2)").PrintPreview
　 Application.CutCopyMode = False
　 Application.ScreenUpdating = True
　 Sheets("hyousi").Select
End Sub

'-------------------------------------------------

mySh = Array("A", "B", "C", "D", "E", "F")
　 For i = LBound(mySh) To UBound(mySh)
　　　Worksheets(mySh(i)).Range("B2:AB32")

なお、ここは、本来は、配列など使わずに、Worksheets(i)などとしたほうが簡単で、また、ベターなのですが、こちらでは、シートの並びなどが見えていないので、こういう書き方にしました。

『"請求印刷 (2)"』という名称は、全角なら全角だけ、半角なら半角だけのほうが、ミスが少ないです。

補足

今試してみました。「保護されたシートに対しはできません。」が
表示されたので
If ActiveSheet.ProtectContents = True Then 'シート保護を解除
ActiveSheet.Unprotect
End If
を追加したのにまた出るので10枚のシートを保護解除しました。
すると「コピー領域と貼り付け領域が違う」とでてしまいました。
様式は下記のとおりなんですが。

http://trydo.web.infoseek.co.jp/100.xls
非常に含蓄のある言葉なので保存して噛み締めて研究したいです。

回答No.1

masa_019

こんにちは。
とりあえず、不必要なSelectをなくすだけでも、
すっきりしたコードになります。
マクロらしいコードかどうかはわかりませんが、
提示されたコードは以下のように書き換えることができます。

Sub 請求書一括印刷2()
With Sheets("請求印刷 (2)")
Sheets("A").Range("B2:AB32").Copy .Range("B1")
Sheets("B").Range("B2:AB32").Copy .Range("B34")
Sheets("C").Range("B2:AB32").Copy .Range("AD1")
' 以下つづく
End With
Sheets("hyousi").Select
End Sub

補足

今試したらできました。これのほうがすっきりしていいです。