ワークシートを任意の名前の軽量PDFにする

軽量PDFに任意のファイル名を付ける

ワークシートの軽量PDF化

ExcelのワークシートをPDF化するとき、ExportAsFixedFormatメソッドを用いると、非常に軽快に動作する反面、出来上がったPDFドキュメントのサイズが異様に大きくなってしまう。

JUST PDF等のPDF化ソフトを用いると、設定次第で極めて小さなPDFドキュメントを作成できる反面、基本的に手作業になってしまうので、数が多いと相当めんどくさい。

というわけで、

akashi-keirin.hatenablog.com

コイツを作成したのだった。

軽量PDF化ツールの弱点

しかし、そもそも上掲ツールは自動印刷のプリンタをJUST PDFに置き換えているだけなので、そもそも

任意のファイル名を指定することができない

という弱点があった。

たとえば、JUST PDF 3の場合、

このように、①「実行時に設定」するか、②「作成元ファイルと同じ」という設定しかない。

①の場合、任意のファイル名を指定することはできるが、保存するたびにダイアログにファイル名を入力しなければならない。目指すのが自動化である以上、この設定は論外。

②の場合、文字通り「作成元のファイル名」すなわち、「[PDF化したいExcelのブック名].pdf」という名前にしかならない。差し込み印刷のような感じで、様式にデータを挿入しつつ、一つ一つPDF化したい、というようなときに、まるで使い物にならない。

任意のファイル名を付けて軽量PDFを作成する

そこで、ちょっとやり方を考えてみた。

手順

• 新規ブックを作成する
• 新規ブックに必要な内容を書き込む
• 新規ブックに任意の名前を付けて保存する
• 新規ブックをPDFプリンタで印刷する
• 新規ブックを閉じる
• 新規ブックを削除する

かなり乱暴なやり方だが、このようにしてみた。

任意の名前の軽量PDFを作成するマクロ

ワークシートにテキトーに文字列を書き込んで、そのワークシートに任意の名前を付けて軽量PDF化するコードを書いてみた。

リスト１　標準モジュール

Public Sub test()
  Dim ar(1 To 10, 1 To 10) As Variant  '……(1)'
  Dim i As Long
  Dim j As Long
  For i = 1 To 10
    For j = 1 To 10
      ar(i, j) = "ち～んｗ"
    Next
  Next
  Dim newBook As Workbook    '……(2)'
  Set newBook = Workbooks.Add
  Dim targetFileName As String    '……(3)'
  targetFileName = ThisWorkbook.Path & "\ち～んｗ.xlsx"
  Call newBook.SaveAs(FileName:=targetFileName)
  Dim rng As Range    '……(4)'
  Set rng = newBook.Worksheets(1).Range("A1").Resize(10, 10)
  rng.Value = ar
  Dim originPrinter As String    '……(5)'
  originPrinter = Application.ActivePrinter
  Application.ActivePrinter = "JUST PDF 3 on Ne03:"  '……(6)'
  Call newBook.Worksheets(1).PrintOut
  Call newBook.Close(SaveChanges:=False)
  Dim fsObj As New FileSystemObject    '……(7)'
  With fsObj
    If .FileExists(targetFileName) Then _
      Call .DeleteFile(targetFileName)
  End With
  Application.ActivePrinter = originPrinter
  Set newBook = Nothing
  Set fsObj = Nothing
End Sub

内容がしょうもない割にタテ長のコードになってしまってすまない。

まずは、(1)からの８行、

Dim ar(1 To 10, 1 To 10) As Variant
Dim i As Long
Dim j As Long
For i = 1 To 10
  For j = 1 To 10
    ar(i, j) = "ち～んｗ"
  Next
Next

後で、新規ブックに書き込むために10×10の「ち～んｗ」が入った配列を準備。

(2)からの２行

Dim newBook As Workbook
Set newBook = Workbooks.Add

で、新規ブックを作成。

(3)からの３行

Dim targetFileName As String
targetFileName = ThisWorkbook.Path & "\ち～んｗ.xlsx"
Call newBook.SaveAs(FileName:=targetFileName)

で、(2)で作成した新規ブックに、SaveAsメソッドで「ち～んｗ.xlsx」というファイル名を付けて保存。

この新規ブックのフルパスは、後で使うので変数targetFileNameに入れておく。

(4)からの３行

Dim rng As Range
Set rng = newBook.Worksheets(1).Range("A1").Resize(10, 10)
rng.Value = ar

で新規ブックの一つ目のワークシートのＡ１セルを起点とする10×10の範囲に、(1)で作成した配列を活用して「ち～んｗ」を書き込む。

(5)からの２行

Dim originPrinter As String
originPrinter = Application.ActivePrinter

で、現在のActivePrinterプロパティの値を取得しておく。後で使用中のプリンタを元に戻すために用いる。

(6)からの３行

Application.ActivePrinter = "JUST PDF 3 on Ne03:"
Call newBook.Worksheets(1).PrintOut
Call newBook.Close(SaveChanges:=False)

で、一旦PDFプリンタに切り替えて印刷（すなわちPDF化）し、新規ブックを保存せずに閉じている。

「JUST PDF 3 on Ne03:」の部分は、うちの環境でこうなっている、というだけなので、異なる環境のもとでは適宜改める必要がある。

これで、（JUST PDF 3使用の場合、）設定で「ファイル名」を「作成元ファイルと同じ」にしておくと、「保存先」で指定したフォルダ内に任意の名前（今回の場合だと「ち～んｗ.pdf」。）のPDFができる。

あとは、(7)からの５行

Dim fsObj As New FileSystemObject
With fsObj
  If .FileExists(targetFileName) Then _
    Call .DeleteFile(targetFileName)
End With

で、FileSystemObjectのDeleteメソッドを用いてPDFの作成元ブック（新規ブック）を削除しておしまい。たった一つのファイルを消すためにわざわざFileSystemObjectのインスタンスを作成するというこの

割鷄焉用牛刀感

たるやｗｗｗ

まあ、FileSystemObjectの練習中ということで勘弁してくだされ。

実行

リスト１を実行して、PDF保存用のフォルダを覗くと……、

ほれ。このように「ち～んｗ.pdf」が燦然と輝いておる！

開いてみると、

バッチリ。

おわりに

かなり乱暴なやり方だという自覚はあります。