Excel VBAで.xlsxファイルをPDFに一括変換する
背景
Linuxサーバ上で.xlsx形式の帳票を出力する機能を実装した際、クライアントから「PDF形式にもできない?」という要望が来ると「ぐぬぬ・・・」ということになる場合があります。
以前、Linuxサーバ上のOpenOfficeやLibreOfficeで.xlsxファイルからPDFへの変換を試したことがあるのですが、フォントや再現性の問題から実用的ではありませんでした。
そこで今回は、.xlsxファイルをPDFに一括変換するExcel VBAマクロを実装した.xlsmファイルを使ってクライアント側のExcelで一括変換してもらおうと思います!(もちろん実際にはクライアントとの交渉次第ですが。。。)
マクロ全容
下記の内容のマクロを実装した「pdf.xlsm」のようなものを準備する想定です。
Sub convertToPdf()
Dim buf As String
Dim cnt As Long
Dim files() As String
Dim rc As Integer
Dim item As Variant
Dim fullname As String
Dim fullnamePdf As String
Dim objExcel As Object 'Excel.Application
Dim objBook As Object 'Excel.Workbook
Dim objFs As Object 'Scripting.FilesystemObject
Set objFs = CreateObject("Scripting.FilesystemObject")
buf = Dir(ThisWorkbook.Path & "\*.xlsx")
cnt = 0
Do While buf <> ""
ReDim Preserve files(cnt)
files(cnt) = buf
cnt = cnt + 1
buf = Dir()
Loop
If cnt = 0 Then
MsgBox (".xlsxファイルが見つからないため終了します。")
Else
rc = MsgBox(".xlsxファイルが" & cnt & "件見つかりました。一括変換処理を行いますか?", vbYesNo + vbQuestion, "確認")
If rc = vbYes Then
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
For Each item In files()
fullname = ThisWorkbook.Path & "\" & item
fullnamePdf = ThisWorkbook.Path & "\" & objFs.GetBaseName(item) & ".pdf"
Set objBook = objExcel.Workbooks.Open(fullname, , True)
objBook .ExportAsFixedFormat 0, fullnamePdf
objBook.Close (False)
Set objBook= Nothing
Next item
objExcel.Quit
Set objExcel = Nothing
MsgBox ("処理が完了しました。")
Else
MsgBox ("処理を中断しました。")
End If
End If
Set objFs = Nothing
End Sub
マクロ解説
.xlsxファイルの列挙
このマクロは.xlsmファイルで利用することを前提として、.xlsmファイルと同じフォルダにある.xlsxファイルを列挙します。
Set objFs = CreateObject("Scripting.FilesystemObject")
buf = Dir(ThisWorkbook.Path & "\*.xlsx")
cnt = 0
Do While buf <> ""
ReDim Preserve files(cnt)
files(cnt) = buf
cnt = cnt + 1
buf = Dir()
Loop
列挙したファイル名は files
配列に格納し、 cnt
でファイル数をカウントしています。
.xlsxファイルをPDFに変換
Excelアプリケーションのオブジェクトを作成して別のExcelを起動し、 ExportAsFixedFormat
で変換します。PDFファイルは「hoge.xlsx」に対して同じフォルダに「hoge.pdf」というファイル名で作成します。
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
For Each item In files()
fullname = ThisWorkbook.Path & "\" & item
fullnamePdf = ThisWorkbook.Path & "\" & objFs.GetBaseName(item) & ".pdf"
Set objBook = objExcel.Workbooks.Open(fullname, , True)
objBook .ExportAsFixedFormat 0, fullnamePdf
objBook.Close (False)
Set objBook= Nothing
Next item
objExcel.Quit
Set objExcel = Nothing
後処理
作成したオブジェクトを破棄します。
Set objFs = Nothing