印刷済みの「報告書」などを模したものを作った場合、入力された行数にかかわらず、そのページの印刷可能な最終行まで罫線を引いて印刷させたい場合があります。
このような場合の処理方法を、「基本操作」の「枠取りした中の右上にページ数を表示」で使用したサンプルフォームを用いて紹介します。
(画像をクリックすると、このサンプルがダウンロードできます)
印刷上での「お体裁」になりますが、明細が数行の入力であっても印刷時にはページいっぱいのところまで罫線を引いてしまう例です。このサンプルでは枠線印刷になっており、実際に罫線を引くのではなく印刷範囲の変更を行なうだけで罫線(枠線)も印刷されます。
今回の処理は、印刷イベントにて起動させます。従って起動ボタンなどはありません。普通に「印刷」や「印刷プレビュー」を行なう時にデータの最終行を判定してそのページの最終行までを印刷範囲に変更します。
'***************************************************************************************************
' 定型書式でページ範囲いっぱいを印刷範囲にする ThisWorkbook(Class)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev 変更履歴内容------------------------------------------------------------------------>
'03/06/07(1.00)新規作成
'20/02/06(1.10)*.xlsm化
'***************************************************************************************************
Option Explicit
'***************************************************************************************************
' ■■■ ワークブックイベント ■■■
'***************************************************************************************************
'* 処理名 ：Workbook_BeforeClose
'* 機能 ：閉じる前イベント
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：Arg1 = Cancel(Boolean) ※Ref参照
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2020年02月06日
'* 作成者 ：井上 治
'* 更新日 ：2020年02月06日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'-----------------------------------------------------------------------------------------------
' ステータスバーメッセージをクリア
Application.StatusBar = False
End Sub
'***************************************************************************************************
'* 処理名 ：Workbook_BeforePrint
'* 機能 ：印刷処理前イベント
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：Arg1 = Cancel(Boolean) ※Ref参照
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年06月07日
'* 作成者 ：井上 治
'* 更新日 ：2020年02月06日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub Workbook_BeforePrint(Cancel As Boolean)
'-----------------------------------------------------------------------------------------------
' 印刷範囲設定
Call SET_PrintArea
' 処理確認
Application.StatusBar = "印刷範囲設定しました。"
' 保存済み状態にする
ThisWorkbook.Saved = True
End Sub
'----------------------------------------<< End of Source >>----------------------------------------
実際の処理本体の記述です。
'***************************************************************************************************
' 定型書式でページ範囲いっぱいを印刷範囲にする Module1(Module)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev 変更履歴内容------------------------------------------------------------------------>
'03/06/07(1.00)新規作成
'20/02/06(1.10)*.xlsm化、記述整理
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const cnsPrintArea = "$A$5:$H$"
'***************************************************************************************************
' ■■■ シート側からの呼び出し処理 ■■■
'***************************************************************************************************
'* 処理名 ：SET_PrintArea
'* 機能 ：印刷範囲を余白いっぱいに取る処理
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年06月07日
'* 作成者 ：井上 治
'* 更新日 ：2020年02月06日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：アクティブなシートに対して作用します
'***************************************************************************************************
Sub SET_PrintArea()
'-----------------------------------------------------------------------------------------------
Dim xlApp As Application ' Excel.Application
Dim objSh As Worksheet ' Worksheet
Dim objWin As Window ' Window
Dim lngRow As Long ' 行INDEX
Dim lngRow2 As Long ' 行INDEX
Dim lngPage As Long ' ページ番号
Dim strErrMSG As String ' エラーメッセージ
' 各オブジェクトの参照を取得
Set xlApp = Application
Set objSh = ActiveSheet
Set objWin = ActiveWindow
' 画面描画を停止
With xlApp
.ScreenUpdating = False
.Cursor = xlWait
End With
On Error GoTo SET_PrintArea_ERROR
' ActiveSheetの処理
With objSh
' 現在､データがある最終行を取得
lngRow = .Range(cnsPrintArea & .Rows.Count).End(xlUp).Row ' ①
' 改頁プレビューに移行
objWin.View = xlPageBreakPreview ' ②
' 一旦､現在最終行より1頁分以上先を最終行にする
lngRow2 = lngRow + 200 ' ③
.PageSetup.PrintArea = cnsPrintArea & CStr(lngRow2)
' 改頁位置を調査し､データ最終行を超えた所までを判定
For lngPage = 1 To .HPageBreaks.Count ' ④
.HPageBreaks(lngPage).Location.Select
lngRow2 = Selection.Row - 1
If lngRow2 >= lngRow Then Exit For
Next lngPage
' 総ページ数をセット(H2セル)
.Cells(2, 8).Value = lngPage ' ⑤
' 判定した所までを印刷範囲とする
.PageSetup.PrintArea = cnsPrintArea & CStr(lngRow2) ' ⑥
' 通常ビューに戻る
objWin.View = xlNormalView ' ⑦
End With
' 終了
GoTo SET_PrintArea_EXIT
'===================================================================================================
' プリンタ未設定等エラー処置
SET_PrintArea_ERROR:
' メッセージのセット
strErrMSG = Err.Description
'===================================================================================================
' 終了
SET_PrintArea_EXIT:
' 画面描画を再開
With xlApp
.Cursor = xlDefault
.ScreenUpdating = True
End With
' メッセージがあれば表示
If strErrMSG <> "" Then
MsgBox strErrMSG, vbCritical
End If
On Error GoTo 0
End Sub
'***************************************************************************************************
'* 処理名 ：CLEAR_PrintArea
'* 機能 ：印刷範囲を見出しだけに戻す処理
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年06月07日
'* 作成者 ：井上 治
'* 更新日 ：2020年02月06日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：アクティブなシートに対して作用します
'***************************************************************************************************
Sub CLEAR_PrintArea()
'-----------------------------------------------------------------------------------------------
Dim xlApp As Application ' Excel.Application
Dim objSh As Worksheet ' Worksheet
' 各オブジェクトの参照を取得
Set xlApp = Application
Set objSh = ActiveSheet
objSh.Cells(2, 8).MergeArea.ClearContents
objSh.PageSetup.PrintArea = cnsPrintArea & "5"
End Sub
'----------------------------------------<< End of Source >>----------------------------------------
- ①
- データの最終行取得です。
- ②
- 印刷上の改ページ位置を取得するため、「改ページプレビュー」に移行します。「表示」メニューの「改ページ プレビュー」をマクロで行なうことです。
- ③
- 一旦、そのページの最終行を超える充分な位置までを印刷範囲として設定します。
(ここでは200行を加算しています。) - ④
- 改ページ単位に改ページ行位置を判定し、その位置がデータの最終行を超える場合の改ページ位置を判定します。同時に総ページ数をカウントします。
- ⑤
- 書式デザインの中に総ページ数をセットします。
- ⑥
- 判定した最終ページの改ページ位置までを印刷範囲として設定し直します。
- ⑦
- 「改ページプレビュー」を「標準」に戻します。