VBA 表を紙いっぱいに印刷範囲設定する方法

一つのワークシートに大きさの異なる複数の表を作成しました。

その大小異なる複数の表にVBAで印刷範囲を設定しましたが、表によって余白が大きかったり小さかったりします。

印刷プレビューから設定しサイズをあわせたら、他の表も同じサイズに設定されてしまいます。つまり、一つの表に縮尺サイズをあわせたら、他のの表も同じ縮尺になってしまうのです。

大小異なるそれぞれの表が、それぞれに紙いっぱいに印刷する方法を教えてください！

よろしくお願いいたします!!

No.3 回答者： 2koma2 回答日時： 2009/04/01 09:14

教本に載っていることは、重要項目が多いが

実際にプログラムを組むときにそれだけで
動くかといえば、動くが「思っている動作と違う」事が
多い。よってコピペをしただけでは、プログラムとは言えんかもね。

今後のために言っておく

(1)同じシートに全く別の表及び形式の違う表を混在させない。
(2)どうしても複数の表が混在する場合は、Worksheetにその表を
コピーしてコピー先をプログラムで動作させる（元は何も変わらない）
(3)マクロで動作した内容を確認して、メソッド、プロパティの中身を
勉強する（かなり有効な勉強方法です）。
(4)実践形式の参考書を数冊所持する（上級テク満載です）。

参考図書『ExcelVBA実践技＆上級技大全』C&R研究所

http://www.amazon.co.jp/Excel-VBA%E5%AE%9F%E8%B7 …

この回答へのお礼

お礼が遅くなり大変申し訳ございませんでした。

参考になるご意見ありがとうございます。

身近にVBAについて相談できる人がいないので、自分なりに勉強していきたいと思います。

お礼日時：2009/04/05 22:36

No.2 回答者： 2koma2 回答日時： 2009/03/30 17:16

Sub bbb()

Dim StrSheet As String '元のシートの名前
Dim IntSheetCount As Integer 'シートを新規追加後の名前
Dim ICount As Integer 'コピーしたColumnsのカウント
Dim I As Integer '印刷方向を決める　2…横　1…縦
Dim BlShoki As Boolean '初期状態が大きすぎる表はエラーを表示する
If TypeName(Selection) = "Range" Then
If Selection.Count > 1 Then

StrSheet = ActiveSheet.Name
Selection.Copy
Worksheets.Add

Cells(1, 1).Select
IntSheetCount = Worksheets.Count

ActiveSheet.Paste
If Selection.Columns.Count >= Selection.Rows.Count Then
I = 2
Else
I = 1
End If
Application.Dialogs(xlDialogPageSetup).Show arg11:=I

For ICount = 1 To Selection.Columns.Count
Columns(ICount).AutoFit
Next ICount
With ActiveSheet
.PageSetup.Zoom = 10
.ResetAllPageBreaks
BlShoki = False
Do Until .HPageBreaks.Count >= 1 Or _
.VPageBreaks.Count >= 1 Or _
.PageSetup.Zoom > 400
.PageSetup.Zoom = .PageSetup.Zoom + 10
BlShoki = True
Loop
If BlShoki = False Then
MsgBox "範囲指定が大きすぎます。小さくして再度実行してください。", vbCritical
Application.DisplayAlerts = False
ActiveSheet.Dielete
Application.DsplayAlerts = False
Worksheets(StrSheet).Cells(1, 1).Select
Exit Sub
End If
MsgBox "印刷の倍率を" & .PageSetup.Zoom & "％に設定しました。", vbInformation
.PrintOut Preview:=True

End With
End If
End If
End Sub
忙しいかったからとりあえず、で
少しおかしいところあるかもしれません。
その辺は自己で修正を。
==================================================
選択範囲を新規Sheetに表示する。
ダイアログの表示後、縦か横を選択してみて。
初期値はColumnsとRowsを比較して自動設定している。
Columnsが大きければ縦表示。そうでなければ横表示。

印刷範囲が大きければ印刷エラーが出て回避。

==================================================
ひとつ言いたいが、ここのスレの住人は意外と親切だが
あなたのように、文書だけで、コードの一つもない場合は
意外と叩かれるから、次はコードも付けたほうが良いと。
まったく解からんくても、少しづつ埋める努力を期待します。

この回答へのお礼

ありがとうございます。ネットで質問するのがはじめてなもので、不親切な質問になってしまいました。大変申し訳ございませんでした。

私はVBA初心者ですので、教則本にあるように、

Sub sss()
Range("A1:E8").Select
Selection.PrintPreview
End Sub

というふうに印刷範囲を設定いたしました。

しかし、都合により1つのシートに大小異なる複数の表を作成し、それぞれに上記のマクロを設定していることにより、それぞれの表の大きさがまちまちになります。その都度「設定」から縮尺を調整しておりますが、他の表も同じように調整されて困っていました。

ご回答いただいたコードは大変高度で理解するのに時間はかかりますが、少しずつ調べてみたいとおもいます。

ありがとうございました！

お礼日時：2009/03/30 20:42

No.1 回答者： 2koma2 回答日時： 2009/03/29 15:17

Sub ズームして印刷()

With ActiveSheet
.PageSetup.Zoom = 100 '倍率を100％に設定
.ResetAllPageBreaks　'改ページ設定をクリア
　　　　'縦横の改ページが1以上かズームが400％以上になるまで
Do Until .HPageBreaks.Count >= 1 _
Or .VPageBreaks.Count >= 1 _
Or .PageSetup.Zoom >= 400
　　　　　　'10％加算
.PageSetup.Zoom = .PageSetup.Zoom + 10
Loop
MsgBox "倍率を " & .PageSetup.Zoom & "%"
.PrintPreview
End With
End Sub
簡単に解説します。
(1)HPageBreaks（水平）とVPageBreaks（垂直）は改ページの方向で
1以上になると2枚目の印刷になります。まぁ当たり前ですけど。

(2)PageSetup.Zoomは印刷倍率です。
Excel2003では400％までです。確か。

まとめると、倍率を10％ずつあげて行く。ただし、次ページを作らないように設定し（(1)あたりを参考に）、かつ倍率が400％以下であれば
さらに10％倍率を足して行く。

DO Untilから抜けるには、改ページが発生するか、倍率400％を超えた場合はDOからぬける。

最後に設定した倍率をMsgBoxに表示する。まぁこんなんはどうでも良い。

最後に印刷プレビューを表示する。いきなり印刷は横暴かと。
いったん確認するくらいで良いのでは？

この回答への補足

早速のご回答誠にありがとうございました！

大変参考になります。

ご回答いただいた方法はシートを印刷する方法だと思いますが、質問本文にも記載いたしました、各表ごとに（Range等で）指定範囲する場合はどのようにすればよいでしょうか？

一つのシートに複数の大きさの異なる表があり、それぞれの表をそれぞれに紙いっぱいに印刷する方法はございますでしょうか？

説明が下手で誠に申し訳ございませんが、ご教授いただくようよろしくお願いいたします。

補足日時：2009/03/29 18:21