ExcelVBAによるExcelからPDFへの変換

Excelでいろいろ集計してグラフとかにまでするんだけど、最終的にはPDFにしたい、っていうことが結構ありました。かなり試行錯誤したんですが、今までに行き着いた結果を書き残しておこうと思います。

やりたいこと

• Excel→PDFに変換して任意のフォルダに名前をつけて保存したい
• 会社のPCなのでむやみにソフトはインストールしたくない
• 同じブック内の全シートを連続してPDF化したい

Acrobat Professional版がインストールされている場合ならば、付属のAcrobat Distillerを使うと一発でできるみたいなんですが、使いたいPC全てにProfessional版が入ってるのは難しいことですので、StandardやReaderなどがインストールされており、「PDFを印刷できるプリンタ」が存在していれば動くのがいいなー、と思って作ったものです。

下準備

1. 「プリンタとFAX」より「Adobe PDF」（インストールしたソフトにより名前が違う可能性があります）のプロパティを開く
2. 「詳細設定」タブ→「標準の設定」をクリック
3. 「保存先フォルダ」をデスクトップへ設定する　※1
4. 「結果のAdobe PDFを表示」のチェックを外す　※2
　

※1　どこでもいいですが、デスクトップが一番わかりやすいかと。
※2　表示されると移動できなくなっちゃうのです

解説

このプログラムは、デフォルトプリンタからPDFプリンタへ切り替えを行い、(00～99まで切り替わるまで試すのでPCごとに番号が違ってもOK）いったんデスクトップへできた“Excelブック名.pdf”のままのPDFファイルを“各シート名.pdf”につけ直して任意のフォルダに移動するというものです。

出力先を直接任意フォルダに指定しても良いのですが、別の用途でPDF印刷を行う時に、全てそのフォルダへ入ってしまいます。複数人でPCを使う可能性がある場合、どこへ出力されたのかわからなくなってしまうため、一番目に入りやすいデスクトップ上に一旦出力する、という方法をとっています。

'ブック内の全シートを、指定フォルダに"各シート名.pdf"で保存する
Sub pdf()
  Dim i As Integer
  Dim s_prn As String, oldprn As String, flg As Boolean
  Dim path1 As String, path2 As String, file As String
  On Error Resume Next

  s_prn = "Adobe PDF" 'インストールされているPDFプリンタの名前
  oldprn = ActivePrinter 'アクティブプリンタを取得


  If InStr(oldprn, s_prn) = 0 Then '切替えたいプリンタがアクティブプリンタでない場合
    flg = False 'プリンタ切替フラグ
    For i = 0 To 99
      ActivePrinter = s_prn & " on Ne" & Format(i, "00") & ":" '「"プリンタ名"on NeXX:」形式PC用
      ActivePrinter = "Ne" & Format(i, "00") & ": の " & s_prn '「NeXX: の "プリンタ名"」形式PC用
      'その他の形式がある場合はこのあたりへ追加
      If ActivePrinter <> oldprn Then
          flg = True 'プリンタ切替成功
          Exit For
      End If
    Next i
    If flg = False Then 'プリンタ切替失敗の場合
      MsgBox "プリンタ名:" & s_prn & " が見つかりません。"
      Exit Sub
    End If
  End If

  path1 = CreateObject("WScript.Shell").SpecialFolders("Desktop") 'PDFプリンタの保存先（移動前）フォルダ※3
  path2 = "C:\" '移動後のフォルダ(仮）※4
  file = Replace(ThisWorkbook.Name, ".xls", ".pdf") 'PDFプリンタ出力直後のファイル名
  For i = 1 To Worksheets.Count '全シート繰り返す
    Sheets(i).PrintOut
    Application.Wait [NOW()+"0:00:3"] '3秒待つ※5
    Name path1 & "" & file As path2 & "" & Sheets(i).Name & ".pdf" 'ファイルの名前を変えて移動
  Next i

  ActivePrinter = oldprn 'アクティブプリンタを元に戻す
  MsgBox "終了しました。"
End Sub

※3　必ず※1で指定した場所と同じにしてください
※4　ここでは仮としてCドライブ直下にしてますが、お好きなフォルダへどうぞ
※5　PDFファイルが出来るまでタイムラグがあるので少し待ちます

どうも、PCによってプリンタ設定の文字列に微妙に違いがあるみたいで、確認できるだけでは「“プリンタ名”on NeXX:」「NeXX: の “プリンタ名”」というのがあったので、15～16行目にてその2つに関しては対応しています。もしも形式が違ってうまくいかなかった場合は、

一旦12行目にプレイクポイントを設置して上の実行ボタンを押してみて下さい。

10行目のoldprnにマウスを載せると取得したデフォルトのプリンタが見れますので、そこの文字列を確認して15,6行目に倣い、その形式の数値の部分をFormat(i, "00")へ、プリンタ名部分をs_prnに変更したものを17行目に入れてみてください。

これを組むにあたって、いろんなサイトのいろんな方のコードを参考にさせていただいて、本来ならここで参考URLを貼りたかったのですが、試行錯誤しすぎて、当時きちんとメモっておかなかったので分からなくなってしまい…大変申し訳ありません。この場にて、厚く厚く御礼申し上げます。