スポンサーリンク
はじめに：複数のExcelファイルを一度に印刷したい
前回の記事では、今まさに開いているExcelファイルについて、PDF変換を素早く実施するマクロを取り上げた。
ただ、業務においては、複数のExcelブック(ファイル)をいっぺんに印刷したいということがよくある。
その際には、印刷する前にExcelファイルを全てPDF化して、場合によっては1つのPDFファイルに全て結合してしまえば効果的だ。
印刷前にイメージをまとめて確認しやすくなるからね。
そういうとき本当は、DocuWorksという文書管理ソフトがあれば、それが凄く使いやすくて最適なのだけどね。
今回はその目的を叶えるため、複数ExcelファイルをPDFに一括変換するマクロを取り上げる。
Excelファイルをたくさん印刷させられまくって大変だって人は、ぜひとも活用いただければと思います。
動作イメージ
では今回のマクロの動作イメージから。
今回のマクロは2つあって、複数のExcelファイルを開かせてそれを全部PDF変換するところはいずれも同じ。
で、それらPDFファイルをどうするかで
(2)10個のExcelファイルがあろうと、生成されるPDFファイルは1つのみで、その中に10Excelファイル分のページが含まれる。
の2つに分けている。
たぶん、1つのPDFファイルに結合する(2)の方が使える場面が多いと思うけどね。
これらマクロを起動すると、Excelファイルを選択させる複数選択可能なダイアログが表示される。
マウスで囲むとかして、複数のExcelファイルを一括選択して実行すると、PDFファイルが生成される。
こういう、複数ファイルをダイアログから同時選択っていうのは、やり慣れない人も多いだろうけど、私は割と好んで使う。
で、マクロ実行の流れを動画にしてみた。
ソースコード
ではソースコード。
2つのマクロに共通化できる部分が多かった。
最初の「Function fncExcelToPDF」「Sub open_PDFSavePath」という2つのやつがそれね。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 |
Function fncExcelToPDF(strFiles() As Variant, fileNum As Long, PDFSavePath As String) As Boolean '複数ExcelファイルをPDF変換するに当たり、まずExcelファイルを開き実行フラグを立てる。 Dim i As Long With Application.FileDialog(msoFileDialogOpen) .AllowMultiSelect = True '複数ファイル選択可能 .Filters.Clear .Filters.Add "excelファイル", "*.xls*" If Not .Show Then Exit Function fileNum = .SelectedItems.Count ReDim strFiles(1 To fileNum) '選択されたファイル群を配列へ格納 For i = 1 To fileNum strFiles(i) = .SelectedItems(i) Next i End With PDFSavePath = Left(strFiles(1), InStrRev(strFiles(1), "\")) '保存場所" fncExcelToPDF = True '実行フラグセット End Function Sub open_PDFSavePath(PDFSavePath As String) 'PDF生成処理の最後に、PDFの保存場所を開くか確認する Call appReset Dim msg As String msg = "終了しました。生成したPDFファイルを下記の場所に保存しています。" msg = msg ＆ vbCrLf ＆ PDFSavePath msg = msg ＆ vbCrLf ＆ "保存場所を開きますか？" If MsgBox(msg, vbQuestion + vbOKCancel, "フォルダOPEN確認") = vbOK Then Shell "C:\Windows\Explorer.exe " ＆ PDFSavePath, vbNormalFocus 'フォルダを開く End If End Sub Sub mergeSheetsToPDF() '複数ブックのアクティブシートを結合し、1つのPDFにする Dim strFiles() As Variant Dim eachWb As Workbook Dim newWb As Workbook Dim i As Long Dim fileNum As Long Dim PDFSavePath As String If Not fncExcelToPDF(strFiles(), fileNum, PDFSavePath) Then Exit Sub On Error Resume Next Set newWb = Workbooks.Add '新規ブックを追加 For i = 1 To fileNum Call appSet Workbooks.Open strFiles(i), ReadOnly:=True Set eachWb = ActiveWorkbook ActiveSheet.Copy after:=newWb.Worksheets(newWb.Worksheets.Count) 'コピーシートを最後尾に作成 '印刷にしか使わないので、セル全体を値のみに直す ActiveSheet.Cells.Value = ActiveSheet.Cells.Value eachWb.Close savechanges:=False Next i 'Application.SheetsInNewWorkbook：新規ブックのシート数設定 For i = Application.SheetsInNewWorkbook To 1 Step -1 newWb.Worksheets(1).Delete 'ブックを新規追加したとき、空白シートが付いてくるので削除 Next i 'ブック全体としてPDF変換 ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _ Filename:=PDFSavePath ＆ Format$(Now, "yyyy年mm月dd日hh時mm分ss秒") ＆ ".pdf" '保存場所を開くか確認 Call open_PDFSavePath(PDFSavePath) End Sub Sub saveBooksAsPDF() '複数ExcelファイルをPDF変換。Excelファイルと同じ数のPDFファイルが生成される Dim eachWb As Workbook Dim strFiles() As Variant Dim PDFFileName As String Dim PDFSavePath As String Dim i As Long Dim fileNum As Long If Not fncExcelToPDF(strFiles(), fileNum, PDFSavePath) Then Exit Sub '現在時刻のフォルダパス PDFSavePath = PDFSavePath ＆ Format$(Now, "yyyy年mm月dd日hh時mm分ss秒") ＆ "\" '"フォルダを新規作成 MkDir PDFSavePath On Error Resume Next For i = 1 To fileNum Call appSet Workbooks.Open strFiles(i), ReadOnly:=True Set eachWb = ActiveWorkbook PDFFileName = Left(eachWb.Name, InStrRev(eachWb.Name, ".") - 1) '拡張子を除くファイル名 PDFFileName = PDFSavePath ＆ PDFFileName ＆ ".pdf" '拡張子をPDFに変えたもの Calculate 'PDF変換する前に再計算しておく 'アクティブシートのみPDF変換 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFileName eachWb.Close savechanges:=False Next i '保存場所を開くか確認 Call open_PDFSavePath(PDFSavePath) End Sub Sub appSet() ‘マクロ処理中に、描画など余計なものを省略して高速化 With Application .ScreenUpdating = False ‘描画を省略 .Calculation = xlCalculationManual ‘手動計算 .DisplayAlerts = False ‘警告を省略。 ‘.EnableEvents = False End With End Sub Sub appReset() ‘描画などの設定を通常通りにリセット With Application .ScreenUpdating = True ‘描画する .Calculation = xlCalculationAutomatic ‘自動計算 .DisplayAlerts = True ‘警告を行う End With End Sub |
最後の「appSet」「appReset」というやつについては、こちらで触れています。
これら「mergeSheetsToPDF」「saveBooksAsPDF」マクロをExcelの個人用マクロブックに組み込んで使うと良いだろう。
そこそこ難しいソースコードだとは思うけど、解説してたらキリがない感じだし、この辺りで。
スポンサーリンク
