LoginSignup
13
19

More than 5 years have passed since last update.

Excel VBAで.xlsxファイルをPDFに一括変換する

Last updated at Posted at 2016-09-29

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
13
19
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
13
19