ExcelをVBAでコントロールして、最後にPDFに出力するってなった時はだいたい
●保存して閉じる
●もう一度開くー＞印刷ファンクションでPDFを指定して印刷
ってことで・・・何でここは手動？ってなりますよね！！
そんな時はこの部屋の方法で表示されている全シートをPDF出力が可能になってとても便利ですよ
また、一番したの方にコメント欄があるからよかったら質問・感想などメッセージ入れてください
Excelの複数シートを纏めてPDFにします
注：Excelブックに含まれる全てのシートが対象となるものです
シートを限定したい場合は、サブルーチンの引数に
手段１：選択するシートのFromToを番号で指定する
手段２：選択するシート名を指定する（選択シートが少ない場合はいいかも）
を入れることをすれば、プログラム内の「ワークシートのグループ化」の箇所を
変更すれば可能となりますよ
※ブックと同じ名前のPDFファイルを、ブックを開いたフォルダに作成します
ExcelブックをPDFに出力するプログラム
●●サブルーチンプログラム●●
標準モジュール（PdfCtrl）にブログラムを記述
※標準モジュールの追加は「201号室：Excelシート内で指定した描画オブジェクトの名前を取得するプログラム」を参照してください
サブルーチンの内容
PdfOutputAll(workbookPath As String)
引数：workbookPath = Excelのフルパス名
戻り：0＝正常終了（固定）
▼プログラム▼
Public Function PdfOutputAll(workbookPath As String)
'------------------------------
Dim ret As Boolean
ret = True
'------------------------------
Dim bookPath As String 'ブックのファイルパス
Dim bookName As String 'ブックのファイル名
Dim pdfName As String 'PDFにするファイル名
Dim buf 'Split用の変数
Dim i As Integer
'------------------------------
'ブック名からPDF名を作成
buf = Split(workbookPath, "\") 'パスで区切る
bookName = buf(UBound(buf)) 'ブック名
bookPath = buf(0)
For i = 1 To (UBound(buf) - 1)
bookPath = bookPath & "\" & buf(i)
Next i
pdfName = ""
buf = Split(bookName, ".")
For i = 0 To (UBound(buf) - 1)
pdfName = pdfName & Trim(buf(i))
Next i
pdfName = bookPath & "\" & pdfName & ".pdf"
'------------------------------
'表示されている全てのワークシートをグループ化
Dim sheetName As String
Dim TopSheetName As String
For i = 1 To Worksheets.Count
sheetName = Worksheets(i).Name
If i = 1 Then
TopSheetName = sheetName
Sheets(sheetName).Select
Else
Sheets(sheetName).Select False
End If
Next
'------------------------------
'グループ化したワークシートをPDF出力
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfName
'------------------------------
'ワークシートのグループ化を解除
Worksheets(TopSheetName).Select
'------------------------------
PdfOutputAll = ret
'------------------------------
End Function
■小技の説明１■
ブック内全てのシートを選択する
Dim sheetName As String <-シート名の一時保存用の変数
Dim TopSheetName As String <-全シート選択を解除するために初めのシート名保存用の変数
For i = 1 To Worksheets.Count <-全シートをループする
sheetName = Worksheets(i).Name <-シートNoからシート名を取得する
If i = 1 Then
TopSheetName = sheetName <-最後に全選択を解除するためにシート名を取得する
Sheets(sheetName).Select <-引数：Replace=True（既定）
Else
Sheets(sheetName).Select False <-引数：Replace=False選択の追加
※CTRLキーを押して別シートをクリック（選択）したのと同じ動作
End If
Next選択の解除＝Worksheets(TopSheetName).Select
動作最後の選択の解除は、なんとなくシートが選択のままだと気持ちわるいから（Kappo談）
呼び出すプログラム（例）
サブルーチンプログラムができたので呼び出すコマンドボタンを配置してプログラムを記述する
コマンドボタンがクリックされた時に実行されるプログラム
「CommandButton9」
※ボタンの配置方法は「VBA 201号室：描画オブジェクトの名前取得」を参照してください
■本ブックの全てのシート■
呼び出すプログラム
▼プログラム▼
Dim fullPath As String 'ワークブックのフルパス
Dim ret As Boolean
fullPath = ThisWorkbook.FullName
ret = PdfOutputAll(fullPath)
Call MsgBox("PDFが作成されました", vbInformation + vbOKOnly, "メッセージ")
コメント