こんにちは!Lenocoです。本日も見てくださりありがとうございます。
今回は複数ワークシートをPDF化する方法についてのTips回です!!!
複数のシートをPDF化&出力シートの削除
先日依頼があったマクロの案件で、
可変的に複数のシートをPDF化する、という動きを作成する必要がありました。
その複数のシートというのは、PDF出力用に作成したシートで、PDF出力後に全部削除する、という流れでした。
なので今回は、複数のシートをPDF化するマクロと、出力したシートを削除するマクロをご紹介いたします。
複数のシートをPDF化する際の前提条件
まず、PDF化したいシートの共通の条件を決めておきます。
今回はシート名で区別するようにしました。
印刷用のシートを作成した際に、必ずシート名の先頭に「print_」と入るようにしていました。
そのため、PDF化の後に削除するシートも、このシート名を基準に決めています。
※この時点ですでにPDFにしたいシートは作成してある状態です。
その前提条件を頭に入れ、この先を読み進めてくださいね。
複数のシートをPDF化するコード
Sub SaveAsPDF()
Dim printWS As Worksheet
Dim printWSArray() As Variant
Dim fileName As String
Dim errorMsg As String
On Error GoTo myError
Erase printWSArray
ReDim printWSArray(0)
'PDF対象のシートを配列に格納
For Each printWS In ThisWorkbook.Sheets
If printWS.name Like "print_*" Then
If printWSArray(0) = "" Then
printWSArray(0) = printWS.name
Else
ReDim Preserve printWSArray(UBound(printWSArray) + 1)
printWSArray(UBound(printWSArray)) = printWS.name
End If
End If
Next printWS
If printWSArray(0) <> "" Then
Worksheets(printWSArray).Select
'PDF出力
fileName = ThisWorkbook.Path & "\" & "print_" & Format(Now, "yyyymmdd hhmmss") & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:=fileName '選択したシートをPDF出力
MsgBox UBound(printWSArray) + 1 & "ページ出力しました。"
Else
'エラー(対象シートがない)
errorMsg = "エラー:PDF対象のシートがありません。" & vbLf & "ご確認ください。"
MsgBox errorMsg
End
End If
Set printWS = Nothing
Exit Sub
myError: '予期せぬエラーがあった場合この行にジャンプします
MsgBox "エラー:PDF対象のシートがありません。" & vbLf & "▼考えられる原因" & vbLf & "・シート上に情報がない", vbExclamation
End
End Sub
複数のシートをPDF化するコードの説明
まず変数を宣言します。
シートループ用のWorksheet型の変数、
PDF化する対象のシート名を保存するVariant型の配列、
PDFの出力先のパスを保存する変数、
出力対象のシートが無かった場合のエラーメッセージ保存用の変数です。
次に、「On Errorステートメント」というものを使用し、
予期せぬエラーが出た場合に、エラー処理に飛ぶよう指示しています。
こちらは後程説明します。
配列を初期化します。
「ReDim printWSArray(0)」で1つ分の配列を作成しました。
次に、シートをループし、PDF対象のシート名を配列に保存していきます。
PDF対象のシート名は必ず先頭に「print_」と入っているので、
その条件と一致するものを配列に格納していきます。
1つ目のシートであれば最初のIf文に入り、
2つ目以降のシートであればElseに入ります。
シートのループが完了したら、
配列に、シート名の情報があるかどうかを確認しています。
ループに入る前に配列を初期化しているため、
「printWSArray(0)」が空であれば、PDF対象のシートは無い、という判断になり、Elseに入ります。
「PDF対象のシートはありません」というエラーメッセージを出力して、「End」で処理を終了します。
「printWSArray(0)」が空でなければIf文に入り、以下の命令で配列に入った該当のシート全てを選択状態にします。
Worksheets(printWSArray).Select
Worksheets(Array(“Sheet1”, “Sheet2”, “Sheet3”)).Select
続いて、PDFのパスを作成します。
今回はマクロと同じフォルダに作成するようにしています。
ファイル名は「print_[現在の日時].pdf」となります
選択されているシート(ActiveSheet)を上記のファイルパスで出力します。
配列の個数から出力されたシート数を計算し、「〇ページ出力しました。」とメッセージを出しています。
「Set printWS = Nothing」で、ワークシートオブジェクトへの参照を解除しています。
さいごに「On Errorステートメント」です。
予期せぬエラーがあった場合、「myError」というエラー処理に飛んでくださいね、という命令を変数宣言の直後にしています。
今回の予期せぬエラーというのが、PDF対象のシートに何も情報がなかった場合です。
手動でやってみると分かるのですが、まっさらなシートを選択した状態で
「ファイル」→「エクスポート」→「PDFの作成」とやると、以下のエラーが表示されます。
このエラーが表示されるとプログラムが停止してしまうため、「On Errorステートメント」で制御しています。
(と言っても、このあとはマクロでエラーメッセージを出して、処理を終了するだけですが・・)
「myError」のエラー処理の直前で「Exit Sub」をしているのは、
正常に処理が終了した(PDFを出力できた)際、この「Exit Sub」が無いと「myError」のエラー処理まで通ってしまうので、それを防ぐためです。
出力したシートを削除するコード
Sub DeletePrintSheet()
Dim printWS As Worksheet
For Each printWS In ThisWorkbook.Sheets
If printWS.name Like "print_*" Then
Application.DisplayAlerts = False
printWS.Delete
Application.DisplayAlerts = True
End If
Next printWS
End Sub
出力したシートを削除するコードの説明
こちらはとてもシンプルです。
シートのループで「print_」から始まるシートがあった場合、
そのシートを削除しています。
シート削除の際「Application.DisplayAlerts」に「False」を入れていますが、
これは、以下の警告が表示されてコードを中断させないためです。
シート削除後に「Application.DisplayAlerts=True」をして、警告が表示されるよう戻すことを忘れないようにしてください!
さいごに
両方うまく動いたら、以下のように2つのコードを呼び出すプロシージャを一つ作ってあげると一連の動作として動いてくれます。
Sub Main()
Call SaveAsPDF
Call DeletePrintSheet
End Sub
以上です!
Lenoco