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

質問

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

回答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％になり、かなり違いがあります。なぜでしょう？