PDF化に関するマクロを教えてください。

質問

初めまして。どなたかご親切な方、教えてください。

エクセルのファイルに、約50のシートがあります。すべて同じ形式で、A4縦1枚に収まるサイズです。それぞれのシートに、外部からのリンクで数値が入るようになっています。このファイルを開いて、

・シートごとに
・シートの名前をファイル名として
・PDF化

したいのです。
例）シート「A商事」→「A商事.pdf」

シートごとにPDF化するところまでは自力で組めたのですが、シートの名前を自動でPDFファイルの名前にする工程がうまく行きません。

なお、作業環境はWindows2000pro、Microsft Office Excel 97、Adobe PDF Writerです。派遣社員で、派遣先の環境のため、バージョンアップしたり新しいソフトを（フリーソフトでも）ダウンロードすることはできません。注文が多くて申し訳ありません。

下記に自分で組んだマクロを記述します。アドバイスよろしくお願いいたします。

Sub PDF化()

Application.ActivePrinter = "Adobe PDF on Ne01:"
For i = 1 To ActiveWorkbook.Sheets.Count
Sheets(i).Activate
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
"Adobe PDF on Ne01:", Collate:=True
Next i
End Sub

回答No.5

mitarashi

もう誰も見ていないと思いますが、他の質問に答えた際に気になって、追加で調べてみました。
Acrobatの「フォントを送信しない」のチェック外すのを、コントロールパネルのプリンタから設定すると、PCをリセットするまでは、有効
ただし、既にxlsブックの、特定シートで、「フォントを送信しない」にチェックが入った状態で出力した事のあるファイルは、そちらの設定が記憶されており、優先されてしまう。
対策としては、対象ブックを開いた状態で、ActiveprinterをAcrobat以外に一旦設定し、再度Acrobatに戻す事で、シート毎の設定がリセットされ、コントロールパネルでの設定が有効になる。
それを盛り込んだコードです。DocuWorksがインストールされているので、それに合わせてありますが、お手元の環境に合わせて、Acrobat以外のプリンタに設定してください。
なお、on Ne 0?: を含むプリンタのリスト取得は、結構難航しましたが、下記に見つけました。（当方、その後プリンタを一時接続したので、ポート番号が変わっています）
http://blogs.yahoo.co.jp/bardiel_of_may/40864687.html

Sub MakePdf()
Dim wbk As Workbook
Dim sh As Worksheet
Dim objAbDist As Object ' ACRODISTXLib.PdfDistiller
Dim strDefaultPrinter As String

Set objAbDist = CreateObject("PdfDistiller.PdfDistiller.1")
strDefaultPrinter = Application.ActivePrinter
Set wbk = Workbooks.Open("C:\Test.xls")
Application.ActivePrinter = "DocuWorks Printer on Ne01:"
Application.ActivePrinter = "Adobe PDF on Ne02:"
Application.ScreenUpdating = False
For Each sh In wbk.Worksheets
sh.PrintOut copies:=1, preview:=False, _
printtofile:=True, collate:=True, prtofilename:="C:\temp.ps"
objAbDist.FileToPDF "C:\temp.ps", "C:\" & sh.Name & ".pdf", vbNullString
Next sh
wbk.Close savechanges:=False
Application.ActivePrinter = strDefaultPrinter
Application.ScreenUpdating = True
End Sub

回答No.4

mitarashi

#1です。
Adobe Acrobat ?. Type Libraryを使う方法をみつけました。
http://questionbox.jp.msn.com/qa197098.html
の回答番号1がそれですが、次の制約があります。
１．Activesheetしか出力しない。
２．印刷範囲を設定してあると、確認のダイアログが表示されてしまい、連続でという訳にいかない。
なお、上記リンク先のNo.1のコードは、Adobe Acrobatに参照設定しているのに、CreateObjectを使っている等、疑問な点もあります。
また、OKwaveの過去の記事に、AcrobatのダイアログをSendkeysで制御する方法がありましたが、VBA側に制御が戻らず、別プロセスのExcelからpdfを出力する方法を試みましたが、ダメでした。

回答No.3

mitarashi

#1です。検証していましたが、Acrobatの「フォントの送信」設定でエラーが出る事があり、難航しました。現状判明したのは、下記の通りです。
'コントロールパネル／プリンタで、Adobe PDFのアイコン上で右クリックし、印刷設定のAdobe PDF設定で、「フォントを送信しない」のチェックを外してから実行しないとエラーになる。
'この箇所をExcelブックで設定する場合は、各シート毎に設定する必要があり、不適当。一旦ブック上で設定してしまうと、情報がファイル内に残ってしまい何かと面倒。
Sub MakePdf()
Dim wbk As Workbook
Dim sh As Worksheet
Dim objAbDist As Object ' ACRODISTXLib.PdfDistiller
Dim strDefaultPrinter As String

Set objAbDist = CreateObject("PdfDistiller.PdfDistiller.1") 'New ACRODISTXLib.PdfDistiller
strDefaultPrinter = Application.ActivePrinter
Application.ActivePrinter = "Adobe PDF on Ne01:"
Set wbk = Workbooks.Open("C:\Test.xls")
Application.ScreenUpdating = False
For Each sh In wbk.Worksheets
sh.PrintOut copies:=1, preview:=False, _
printtofile:=True, collate:=True, prtofilename:="C:\temp.ps"
objAbDist.FileToPDF "C:\temp.ps", "C:\" & sh.Name & ".pdf", vbNullString
Next sh
wbk.Close savechanges:=False
Application.ActivePrinter = strDefaultPrinter
Application.ScreenUpdating = True
End Sub
数年来MS Office＋Adobe Acrobatを使用しておりますが、Adobe PDF Makerとそのご先祖様のAdobe PDF Writerの意味を今回初めて知りました。Excelのメニューバーの端にある、Adobe PDF のメニューを一度も使った事がありませんでした(^^;)
このアドインを制御できれば、もっと簡単に出来るのかもしれませんが、その道の達人にお任せします。

お礼

ありがとうございます。

今日の昼間、教えていただいたマクロを自分で試してみましたが、まさにおっしゃる通りのところで難航しており、再度ご質問申し上げようかと思っていたところです。（とはいえ、いくつかのコードを使わせて頂き、はじめに考えていたものには及ばないながら、ある程度役に立つものを組むことができました。これもはじめのご回答をいただいたおかげです。ありがとうございます。）

まだ、引き続き、アドバイスを募集させていただきたいと思います。よろしくお願いいたします。

回答No.2

mitarashi

#1です。
開いたブックを閉じるタイミングを間違えてました。差し替え願います。
objAbDist.FileToPDF "C:\temp.ps", "C:\" & ActiveSheet.Name & ".pdf", vbNullString
で、PostScriptファイルからpdfを生成後、閉じないといけませんね。
ActiveWorkbook.Close savechanges:=False
もう寝ます。

回答No.1

mitarashi

Acrobat 7.0 Standardの環境ではとりあえず動きました。眠いので検証・推敲不十分ですがご参考まで。
'出典 http://oshiete1.goo.ne.jp/qa1416324.html
Sub MakePdf2()
Dim objAbDist As Object ' ACRODISTXLib.PdfDistiller
Dim strDefaultPrinter As String

Set objAbDist = CreateObject("PdfDistiller.PdfDistiller.1") 'New ACRODISTXLib.PdfDistiller

strDefaultPrinter = Application.ActivePrinter
Application.ActivePrinter = "Adobe PDF on Ne01:"

Workbooks.Open ("C:\Test.xls")
ActiveSheet.PrintOut copies:=1, preview:=False, _
printtofile:=True, collate:=True, prtofilename:="C:\temp.ps"
ActiveWorkbook.Close savechanges:=False
objAbDist.FileToPDF "C:\temp.ps", "C:\" & ActiveSheet.Name & ".pdf", vbNullString
Application.ActivePrinter = strDefaultPrinter
End Sub