前回の記事に印刷プレビューor印刷をユーザーが選択できるようにしてみました。
実行時にダイアログが表示 され、
✅ 「OK」 を押す → すべてのシートを自動印刷
✅ 「キャンセル」 を押す → すべてのシートをプレビュー表示しながら手動で確認
📌 どちらがおすすめ?
方法 | メリット | デメリット |
---|---|---|
手動確認 (PrintPreview) | 1つ1つ確認しながら印刷できる | 多くのシートを印刷する場合、手間がかかる |
自動印刷 (PrintOut) | すべてのシートを一括印刷できる | 間違えても途中で止められない |
選択式 (OK → 自動 / キャンセル → 確認) | ユーザーが選択できる柔軟な対応 | 確認が必要な場合は手間がかかる |
📌 追加されたポイント
- マクロ実行時に印刷方法を選択するダイアログを表示
- ユーザーが
OK
を押したら自動印刷 (PrintOut
) キャンセル
を押したらプレビュー (PrintPreview
)- すべてのシートで同じ印刷方式を適用
- 処理後に完了メッセージを表示
手動確認 or 自動印刷を選べるVBA
Dim confirmPrint As VbMsgBoxResult
confirmPrint = MsgBox("印刷を自動で行いますか?" & vbCrLf & "OK → 自動印刷 / キャンセル → プレビュー", vbOKCancel + vbQuestion, "印刷方法の選択")
If confirmPrint = vbOK Then
ws.PrintOut ' 💡 OKなら自動印刷
Else
ws.PrintPreview ' 💡 キャンセルならプレビュー
End If
前回の記事に追加したコード
Sub PrintSheetsWithFukuokaShops()
Dim ws As Worksheet ' 各シートを処理するための変数
Dim dataSheet As Worksheet ' データシート(店番と店名があるシート)
Dim fukuokaShops As Object ' 福岡の店番を格納する辞書(重複回避)
Dim cell As Range ' セルを走査するための変数
Dim password As String ' シート保護解除用のパスワード
Dim shopCode As Variant ' 各シートの店番コード
Dim printRange As Range ' 印刷範囲
Dim confirmPrint As VbMsgBoxResult ' ユーザーが選択する印刷方法
' ① ユーザーに印刷方法を選択させる
confirmPrint = MsgBox("印刷を自動で行いますか?" & vbCrLf & "OK → 自動印刷 / キャンセル → プレビュー", vbOKCancel + vbQuestion, "印刷方法の選択")
' ② データシートの設定(店番コードと店名があるシート)
Set dataSheet = ThisWorkbook.Sheets("データシート")
' ③ 福岡の店番を格納する辞書(重複を避けるために使用)
Set fukuokaShops = CreateObject("Scripting.Dictionary")
' シート保護解除用のパスワード(不要なら "" に設定)
password = "1234"
' ④ データシートのC列を走査し、「福岡」の店番を辞書に格納
For Each cell In dataSheet.Range("C1:C" & dataSheet.Cells(Rows.Count, 3).End(xlUp).Row)
' C列が "福岡" の場合、A列の店番を辞書に格納(店名が空白でも処理)
If cell.Value = "福岡" And Not fukuokaShops.exists(cell.Offset(0, -2).Value) Then
fukuokaShops.Add cell.Offset(0, -2).Value, True
End If
Next cell
' ⑤ 各シートをループして、該当するシートのみ印刷
For Each ws In ThisWorkbook.Worksheets
' データシート自体はスキップ(印刷対象外)
If ws.Name <> dataSheet.Name Then
' ⑥ シート保護が有効なら解除
If ws.ProtectContents Then
On Error Resume Next
ws.Unprotect Password:=password
If Err.Number <> 0 Then
MsgBox "シート '" & ws.Name & "' の保護を解除できませんでした。", vbCritical
Exit Sub
End If
On Error GoTo 0
End If
' ⑦ B2 または C4 に店番があるかチェック
If Not IsEmpty(ws.Range("B2").Value) Then
shopCode = ws.Range("B2").Value
If fukuokaShops.exists(shopCode) Then
' A1:T60 を **書式①** で書式設定して印刷
Set printRange = ws.Range("A1:T60")
Call FormatAndPrintSheet_Type1(ws, printRange, confirmPrint)
End If
End If
If Not IsEmpty(ws.Range("C4").Value) Then
shopCode = ws.Range("C4").Value
If fukuokaShops.exists(shopCode) Then
' A1:M46 を **書式②** で書式設定して印刷
Set printRange = ws.Range("A1:M46")
Call FormatAndPrintSheet_Type2(ws, printRange, confirmPrint)
End If
End If
End If
Next ws
' 完了メッセージ
MsgBox "福岡の店番があるシートの印刷が完了しました。", vbInformation
End Sub
' ⑧ 【書式①】B2 に店番がある場合の書式設定と印刷
Sub FormatAndPrintSheet_Type1(ws As Worksheet, printRange As Range, confirmPrint As VbMsgBoxResult)
' ⑨ 書式設定(書式①)
With printRange
.Font.Name = "Arial"
.Font.Size = 12
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Interior.Color = RGB(200, 200, 255)
End With
' ⑩ 印刷設定
With ws.PageSetup
.PrintArea = printRange.Address
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.CenterHorizontally = True
.CenterVertically = True
End With
' ⑪ 印刷の選択(自動印刷 or プレビュー)
If confirmPrint = vbOK Then
ws.PrintOut ' 💡 自動印刷
Else
ws.PrintPreview ' 💡 プレビュー表示
End If
End Sub
' ⑫ 【書式②】C4 に店番がある場合の書式設定と印刷
Sub FormatAndPrintSheet_Type2(ws As Worksheet, printRange As Range, confirmPrint As VbMsgBoxResult)
' ⑬ 書式設定(書式②)
With printRange
.Font.Name = "Calibri"
.Font.Size = 10
.Font.Italic = True
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.Interior.Color = RGB(255, 255, 200)
End With
' ⑭ 印刷設定
With ws.PageSetup
.PrintArea = printRange.Address
.LeftMargin = Application.InchesToPoints(0.3)
.RightMargin = Application.InchesToPoints(0.3)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.CenterHorizontally = False
.CenterVertically = False
End With
' ⑮ 印刷の選択(自動印刷 or プレビュー)
If confirmPrint = vbOK Then
ws.PrintOut ' 💡 自動印刷
Else
ws.PrintPreview ' 💡 プレビュー表示
End If
End Sub
コメント