エクセルで拡大して1枚に印刷は？

質問

エクセルで画面を縮小して、はみ出ないように1枚に印刷することができます。
逆に、100％で印刷すると小さすぎるため、拡大して1枚に印刷することができるでしょうか？

回答No.13

watabe007 · ベストアンサー

>ただ、2回目のループのためにmyZoom2と変数を分けていますが、
emaxemax さんが提示したコード
For myZoom = myZoom To myZoom - 20 Step -1
　　↑これは変化　↑これは固定
変数を分けなければ、不具合が生じるでしょう

お礼

あ、なるほど！
ありがとうございました。

回答No.14

chayamati

今晩は
＞エクセルで画面を縮小して、はみ出ないように1枚に印刷できます。
　プリンターのプロパティーで任意倍率または印刷用紙サイズに合わせる。
　ですね
＞拡大して1枚に印刷することができるでしょうか？
　こちらも、ほぼ同じ要領です。
　拡大率を最大の400％とした後、印刷用紙サイズに合わせる
Excel2016、プリンあーはブラザーのDCP-J952Nを使用しています。
添付は、B5サイズのSheetを印刷用紙サイズA4拡大印刷されます。

お礼

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

回答No.12

watabe007

やっぱり100％から増やして行き、２ページになったところで
1％づつ減らして行った方が早いですね
Sub MyPrint5()
　　Dim myZoom As Long, myZoom2 As Long
　　With ActiveSheet.PageSetup
　　　　For myZoom = 100 To 400 Step 10
　　　　　　.Zoom = myZoom
　　　　　　DoEvents
　　　　　　Application.StatusBar = myZoom
　　　　　　myZoom2 = myZoom
　　　　　　If .Pages.Count = 2 Then Exit For
　　　　Next
　　　　For myZoom = myZoom2 To myZoom2 - 10 Step -1
　　　　　　.Zoom = myZoom
　　　　　　DoEvents
　　　　　　Application.StatusBar = myZoom
　　　　　　If .Pages.Count = 1 Then Exit For
　　　　Next
　　End With
　　ActiveSheet.PrintOut Preview:=True
End Sub

お礼

少し時間がかかるのが気になりますが、この方法が一番正しくプリンターでの印刷範囲目いっぱい拡大できますね。
ただ、2回目のループのためにmyZoom2と変数を分けていますが、これはなにか理由があるのでしょうか？

回答No.11

watabe007

>10%ずつでは刻みがあらすぎ、1％刻みでは時間がかかるので
そうですね、修正しました。
Sub MyPrint4()
　　Dim myZoom As Long, myZoom2 As Long
　　With ActiveSheet.PageSetup
　　　　For myZoom = 400 To 10 Step -10
　　　　　　.Zoom = myZoom
　　　　　　DoEvents
　　　　　　Application.StatusBar = myZoom
　　　　　　myZoom2 = myZoom
　　　　　　If .Pages.Count = 1 Then Exit For
　　　　Next
　　　　myZoom2 = myZoom2 - 1
　　　　For myZoom = myZoom2 To myZoom2 + 20
　　　　　　.Zoom = myZoom
　　　　　　DoEvents
　　　　　　Application.StatusBar = myZoom
　　　　　　myZoom2 = myZoom2
　　　　　　If .Pages.Count = 2 Then Exit For
　　　　Next
　　　　.Zoom = myZoom - 1
　　　　DoEvents
　　End With
　　ActiveSheet.PrintOut Preview:=True
End Sub

お礼

ありがとうございます。

回答No.10

okok456

失礼しました。
「フィットページ」もしくは「印刷用紙に合わせる」が無いプリンターが有るかもしれませんね。

ご存じかもしれませんが
Excelの「改ページプレビュー」を試しみてはいかがでしょう。
ページ設定で用紙サイズを設定し
「改ページプレビュー」を表示し
半自動レベルですが青い点線をドラックするだけです。
https://www.manetama.jp/report/excel-hack-print-range/

お礼

何度もありがとうございました。

回答No.9

okok456

追伸
「フィットページ」もしくは「印刷用紙に合わせる」に設定ば
自動的に選択した用紙サイズに拡大/縮小しますよ。

お礼

ありがとうございます。

回答No.8

watabe007

参考に
Sub MyPrint3()
　　Dim myZoom As Long
　　With ActiveSheet.PageSetup
　　　　.CenterHorizontally = True '水平方向の中央寄せにする
　　　　.CenterVertically = True '垂直方向の中央寄せにする
　　　　For myZoom = 400 To 10 Step -10
　　　　　　.Zoom = myZoom
　　　　　　DoEvents
　　　　　　If .Pages.Count = 1 Then Exit For
　　　　Next
　　End With
　　ActiveSheet.PrintOut Preview:=True
End Sub

お礼

ありがとうございます。
これで出来ました。
ただ、10%ずつでは刻みがあらすぎ、1％刻みでは時間がかかるので以下のようにしてみました。
Sub MyPrint33()
Dim myZoom As Long
With ActiveSheet.PageSetup
For myZoom = 100 To 400 Step 20
.Zoom = myZoom
Application.StatusBar = myZoom
DoEvents
If .Pages.Count = 2 Then Exit For
Next
For myZoom = myZoom To myZoom - 20 Step -1
.Zoom = myZoom
Application.StatusBar = myZoom
DoEvents
If .Pages.Count = 1 Then Exit For
Next
End With
ActiveSheet.PrintOut Preview:=True
End Sub

回答No.7

tsubu-yuki

力業がお嫌いじゃなければ、
Select～Case 一杯で頑張れます。
下記だととりあえずプレビューします。

Dim P_Area As Range
Dim P_Width As Double, P_Height As Double
Dim P_Size_L As Double, P_Size_S As Double
Dim X_Margin As Double, Y_Margin As Double

　　With ActiveSheet.PageSetup
　　　　Set P_Area = Range(.PrintArea)
　　　　　　P_Width = P_Area.Width: P_Height = P_Area.Height

　　　　Select Case .PaperSize
　　　　　　Case 8
　　　　　　　　Select Case .Orientation
　　　　　　　　　　Case 1
　　　　　　　　　　　　P_Size_L = Application.CentimetersToPoints(29.7)
　　　　　　　　　　　　P_Size_S = Application.CentimetersToPoints(42)

　　　　　　　　　　Case 2
　　　　　　　　　　　　P_Size_L = Application.CentimetersToPoints(42)
　　　　　　　　　　　　P_Size_S = Application.CentimetersToPoints(29.7)

　　　　　　　　　　End Select

　　　　　　Case 9
　　　　　　　　　　Select Case .Orientation
　　　　　　　　　　　　Case 1
　　　　　　　　　　　　　　P_Size_L = Application.CentimetersToPoints(21)
　　　　　　　　　　　　　　P_Size_S = Application.CentimetersToPoints(29.7)

　　　　　　　　　　　　Case 2
　　　　　　　　　　　　　　P_Size_L = Application.CentimetersToPoints(29.7)
　　　　　　　　　　　　　　P_Size_S = Application.CentimetersToPoints(21)

　　　　　　　　　　End Select

　　　　　　Case Else
　　　　　　　　Exit Sub

　　　　End Select

　　　　X_Margin = .LeftMargin + .RightMargin: Y_Margin = .TopMargin + .BottomMargin

　　　　Select Case (P_Size_L - X_Margin) / P_Width > (P_Size_S - Y_Margin) / P_Height
　　　　　　Case True
　　　　　　　　.Zoom = (P_Size_S - Y_Margin) / P_Height * 100

　　　　　　Case False
　　　　　　　　.Zoom = (P_Size_L - X_Margin) / P_Width * 100

　　　　End Select
　　End With

　　ActiveSheet.PrintOut Preview:=True

現状、Ａ３とＡ４しか考えていません。
印刷範囲・用紙サイズ・用紙の向きが設定してあるのが条件です。
ご承知の通り、４００％を超える倍率はエクセルの能力上、不可能です。
そのエラー処理は面倒なのでしていないです。

お礼

これすごいですね！！
瞬時にできてしまいます。
この方法で行きたいと思います。
ありがとうございました。

補足

すみません、この方法は非常に早くて素晴らしいのですが、おなじページを
Sub MyPrint33()
Dim myZoom As Long
With ActiveSheet.PageSetup
For myZoom = 100 To 400 Step 20
.Zoom = myZoom
Application.StatusBar = myZoom
DoEvents
If .Pages.Count = 2 Then Exit For
Next
For myZoom = myZoom To myZoom - 20 Step -1
.Zoom = myZoom
Application.StatusBar = myZoom
DoEvents
If .Pages.Count = 1 Then Exit For
Next
End With
ActiveSheet.PrintOut Preview:=True
End Sub
でやったものと拡大率が異なり、小さくなってしまいます。
Sub MyPrint33でやると308%でちょうどよいのですが、これが284％になり、かなり違いがあります。なぜでしょう？

回答No.6

HohoPapa

過日ポストしたコードには誤りがあり、
禁じ手を使っているので再考してみました。

それでも、期待の性能がまったく出ないので、
気休め程度に参考としてください。　m(_ _)m

Sub MyPrint2()

　Dim MyZoom As Long
　Const Grain_size = 1
　MyZoom = 400

　Application.ScreenUpdating = False
　Do
　　Worksheets(1).PageSetup.Zoom = MyZoom
　　Worksheets(1).PageSetup.Orientation = xlPortrait　'一旦縦置きに
　　Worksheets(1).PageSetup.Orientation = xlLandscape '再度横置きに

　　If ActiveSheet.PageSetup.Pages.Count < 2 Then Exit Do
　　MyZoom = MyZoom - Grain_size
　　If MyZoom < 10 Then Exit Do
　Loop
　Application.ScreenUpdating = True

　MyZoom = MyZoom
　MsgBox "印刷ページは" & ActiveSheet.PageSetup.Pages.Count & " ページです。"
　MsgBox "倍率は" & MyZoom & " です。"

End Sub

お礼

ありがとうございました。
エクセルが応答なしになってしまいました。

回答No.5

ts0472

質問内容を理解できていない部分がありますが

私は用紙サイズの破線を基準にしています
https://excelmania.club/print_size.html
https://nekochira.com/paper-size-setting/

なので　Excel側で用紙サイズをA5やB5など　表が納まる用紙サイズにして　プリンター側で拡大縮小印刷を実行すれば可能なんじゃないかと思います
元サイズA5→印刷サイズA4　という方法

お礼

わたしの質問が悪くてご迷惑をおかけいたしました。
プリンター側をいじれない（どんなプリンターをつかうかわからない）ので自動で拡大したかったのです。

回答No.4

HohoPapa

期待される機能はないと思います。

なお、
指定可能な倍率（Zoom）は10%～400%ですので、
次のようなコードで
1ページに収まる倍率を求める対応を思いつきますが
禁じての　SendKeys　を使うことになるので、
使い物になるか、極めて怪しいです。
よかったら参考にしてください。

Sub MyPrint()

　Dim MyZoom As Long
　Const Grain_size = 10　　'10%刻みで調べる
　MyZoom = 400

　Do
　　Worksheets(1).PageSetup.Zoom = MyZoom
　　SendKeys "%c"
　　Worksheets(1).PrintPreview
　　If ActiveSheet.PageSetup.Pages.Count < 2 Then Exit Do
　　MyZoom = MyZoom - Grain_size
　　If MyZoom < 10 Then Exit Do
　Loop

　MyZoom = MyZoom + Grain_size
　MsgBox "印刷ページは" & ActiveSheet.PageSetup.Pages.Count & " ページです。"
　MsgBox "倍率は" & MyZoom & " です。"

End Sub

お礼

ありがとうございます。