選択範囲を1枚の用紙にクイック印刷するマクロ

選択中のセル範囲を、1枚の用紙にクイック印刷するマクロを紹介します。
　

選択範囲を印刷範囲に設定する
上下左右の余白を0にする
水平方向をセンタリングする
拡大縮小を「シートを1ページに印刷」にする
範囲の高さと幅を比べて用紙の縦横を決める
印刷する

を一括で行うマクロです。

ソースコードは単純で大したことありませんが、
みなさんのお仕事の内容によっては、ものすごく便利なマクロだと思います。
（私はめっちゃ使います）

実行型の便利マクロですので、
Excel起動時に裏で開かれる「個人用マクロブック」などに搭載して使ってください。

今回のマクロは、「クイックアクセスツールバー」の、
「クイック印刷」の隣(もしくは代わり)に置くと便利かと思われます。

ソースコード

Sub 選択範囲を1枚の用紙にクイック印刷する()
    With ActiveSheet.PageSetup
    
        ' 行列全体・シート全体・単独セルで実行時は、シート全体を印刷範囲とみなす
        Dim 印刷エリア As Range
        If Selection.Address = Selection.EntireRow.Address _
        Or Selection.Address = Selection.EntireColumn.Address Then
            Set 印刷エリア = Range(Cells(1, 1), ActiveSheet.UsedRange)
            .PrintArea = ""
        ElseIf Selection.Cells.Count = 1 Then
            Set 印刷エリア = Range(Cells(1, 1), ActiveSheet.UsedRange)
            .PrintArea = ""
            
        ' それ以外はSelectionを印刷範囲に設定
        Else
            Set 印刷エリア = Selection
            .PrintArea = Selection.Address
        End If
        
        ' すべての余白を0にして水平だけセンタリング
        .LeftMargin = 0: .RightMargin = 0
        .TopMargin = 0: .BottomMargin = 0
        .HeaderMargin = 0: .FooterMargin = 0
        .CenterHorizontally = True
    
        ' 拡大縮小設定を「シートを1ページに印刷」に
        .Zoom = False
        .FitToPagesWide = 1: .FitToPagesTall = 1
        
        ' 印刷エリアが横長なら用紙を横に（基本は縦がいいので10行分くらい高さ有利で判定）
        .Orientation = IIf(印刷エリア.Height + 160 _
                               > 印刷エリア.Width, xlPortrait, xlLandscape)
    
        ' 印刷
        ActiveSheet.PrintOut

    End With
End Sub

解説

処理の流れは冒頭の通りですね。

PageSetupオブジェクトのプロパティをいろいろと編集していますが、
内容はコメントの通りですし、解説は割愛します。

「さすがにいきなり印刷はちょっと…」という方は、

ActiveSheet.PrintPreview

これに書き換えれば印刷ではなく印刷プレビューに変更できます。

あとは「水平のセンタリング」はうれしいときと邪魔な時があり、
私は7:3のイメージなので実装していますが、いらなければ↓を消してください。

.CenterHorizontally = True

シート全体を印刷したい場合に、わざわざドラッグでセルを選択するのは面倒なので、
「すべてのセル、行全体、列全体、1つのセル」いずれを選択して実行しても、
シート全体を印刷する仕様になっています。

とりあえず全部印刷したい場合は、
どこかのセルを1つ選択して実行すればOK。

一応説明しておくと、それがこの部分↓になりますが、

If Selection.Address = Selection.EntireRow.Address _
Or Selection.Address = Selection.EntireColumn.Address Then
    Set 印刷エリア = Range(Cells(1, 1), ActiveSheet.UsedRange)
    .PrintArea = ""
ElseIf Selection.Cells.Count = 1 Then
    Set 印刷エリア = Range(Cells(1, 1), ActiveSheet.UsedRange)
    .PrintArea = ""