前回の記事では、印刷プレビューを設定していましたが、複数ある場合時間がかかりすぎるので、PDF出力するようにしてみました。
複数のシートをPDF出力する
前回の記事のコードを修正して、PDF出力するようにしてみました。
修正したコード
Sub PrintSheetsWithFukuokaShops_PDF_Only()
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 excludeSheets As Variant ' 除外するワークシートリスト
Dim i As Integer
' ① 除外するワークシートをリスト化
excludeSheets = Array("データ1", "データ2", "データ3")
' ② データシートの設定（店番コードと店名があるシート）
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)
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
' ⑤ 各シートをループして、該当するシートのみPDF出力
For Each ws In ThisWorkbook.Worksheets
' 除外リストに含まれるシートはスキップ
For i = LBound(excludeSheets) To UBound(excludeSheets)
If ws.Name = excludeSheets(i) Then GoTo NextSheet
Next i
' ⑥ シート保護が有効なら解除
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 を **書式①（B2の店番用）** で設定してPDF出力
Set printRange = ws.Range("A1:T60")
Call ExportToPDF_WithoutSave(ws, printRange, True) ' True = B2の設定
End If
End If
If Not IsEmpty(ws.Range("C4").Value) Then
shopCode = ws.Range("C4").Value
If fukuokaShops.exists(shopCode) Then
' A1:M46 を **書式②（C4の店番用）** で設定してPDF出力
Set printRange = ws.Range("A1:M46")
Call ExportToPDF_WithoutSave(ws, printRange, False) ' False = C4の設定
End If
End If
NextSheet:
Next ws
' ⑧ 印刷シート（AJ5:AO10）もPDF出力
Call PrintSpecialRange_PDF
' 完了メッセージ
MsgBox "福岡の店番があるシートと印刷シートのPDF出力が完了しました。", vbInformation
End Sub
' ⑨ PDF出力処理（B2・C4 で異なる余白設定 & フォント設定）
Sub ExportToPDF_WithoutSave(ws As Worksheet, printRange As Range, isB2 As Boolean)
' ⑩ フォントサイズを変更
If isB2 Then
' 🔹 B2の店番があるシート → 6行目～10行目のみフォントサイズ変更
With ws.Range("A6:T10").Font
.Size = 12
.Bold = True
End With
Else
' 🔹 C4の店番があるシート（すべての範囲）
With printRange.Font
.Size = 10
.Bold = True
End With
End If
' ⑪ 印刷範囲と書式を設定
With ws.PageSetup
.PrintArea = printRange.Address
.Orientation = xlPortrait
.PaperSize = xlPaperA4
' ⑫ 余白設定
If isB2 Then
.LeftMargin = Application.InchesToPoints(0.4)
.RightMargin = Application.InchesToPoints(0.4)
.TopMargin = Application.InchesToPoints(0.7)
.BottomMargin = Application.InchesToPoints(0.7)
Else
.LeftMargin = Application.InchesToPoints(0.6)
.RightMargin = Application.InchesToPoints(0.6)
.TopMargin = Application.InchesToPoints(0.9)
.BottomMargin = Application.InchesToPoints(0.9)
End If
.CenterHorizontally = True
.CenterVertically = True
End With
' ⑬ PDFとしてエクスポート（保存なし）
ws.ExportAsFixedFormat Type:=xlTypePDF
End Sub
' ⑭ 「印刷」シートの特定範囲 (AJ5:AO10) をPDF出力
Sub PrintSpecialRange_PDF()
Dim ws As Worksheet
Dim printRange As Range
' ① 「印刷」シートを設定
Set ws = ThisWorkbook.Sheets("印刷")
' ② 印刷範囲（AJ5:AO10）を設定
Set printRange = ws.Range("AJ5:AO10")
' ③ フォントサイズを変更（例：14ポイント）
With printRange.Font
.Name = "Arial"
.Size = 14
.Bold = True
End With
' ④ 書式設定
With ws.PageSetup
.PrintArea = printRange.Address
.Orientation = xlPortrait
.PaperSize = xlPaperA4
.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
' ⑤ PDFとしてエクスポート（保存なし）
ws.ExportAsFixedFormat Type:=xlTypePDF
End Sub
📢 まとめ
✅ 「B2」店番シート → 6行目～10行目のフォントサイズを変更（12）
✅ 「C4」店番シート → すべてのフォントサイズを変更（10）
✅ 「印刷」シート（AJ5:AO10）も A4縦向きで PDF 出力（フォントサイズ 14）
コメント