excel マクロ PDF化の際のエラーについて

質問

エクセルブックを一括で名前をつけてpdfに変換するようなマクロを作ろうとして作ってみました。
基本は、マクロで印刷を一気に行う要領でpdfをアクティブプリンタに設定したのですが、見かけ上pdfファイルが作成されるものの、開くと破損していますとなってしまい、きちんとpdf化が出来ていないようです。

システムフォントを利用～のエラーは回避できたのですが、無理やりファイル名を指定しているせいでこのようになっているのでしょうか。
お手数ですがアドバイスをお願いします。

マクロの記録ではアクティブプリンタを指定して、プリントアウトというものしか記録されないので、プリントアウトのところが何か間違っているとは思うのですが・・・

以下コードです。

Sub PrtPDF()
Dim MyFile As String, MyPath As String
Dim wb As Object
Dim fn As String

If vbNo = MsgBox("フォルダ内のブックの一括印刷を行いますか？", vbYesNo) Then GoTo CloseFile

Dim bookname1 As String
bookname1 = "Conv.xls"

MyPath = ThisWorkbook.Path & "\" '自分のパスを取得
MyFile = Dir(MyPath & "*.xls", vbNormal) 'パス内のxlsファイル

If LCase(MyFile) = LCase(bookname1) Then MyFile = Dir 'MyFileとbookname1が同じファイルの場合スキップする
Do Until MyFile = "" '対象ファイルがなくなるまで
Set wb = Workbooks.Open(MyPath & "\" & MyFile) '選択したファイルを開く

fn = MyPath & "PDF\" & Range("J4").Value & ".pdf"

'アクティブシートを印刷する。
Application.ActivePrinter = "Adobe PDF on Ne07:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, PrtoFileName:=fn

'アクティブブックを閉じる。
ActiveWorkbook.Close

MyFile = Dir '次のファイルを検索
If LCase(MyFile) = LCase(bookname1) Then MyFile = Dir 'MyFileとbookname1が同じファイルの場合スキップする
Set wb = Nothing

Loop '繰り返し
GoTo ProcessEnd

CloseFile:

ActiveWorkbook.Close
MsgBox "処理を中止しました。"
Exit Sub

ProcessEnd:

MsgBox "処理が終了しました"

End Sub

回答No.2

mitarashi

本家Acrobatをお使いなら、下記がご参考になるでしょう。
http://okwave.jp/qa/q6205938.html

フリーソフトなら、
pdfcreatorをお勧めします。
http://sourceforge.jp/projects/pdfcreator/
一部しか試してないですが、下記にExcel VBAのサンプルコードがあります。
http://www.excelguru.ca/node/21

お礼

＜自己解決＞
acrobatを通常使うプリンターに設定し、通常の自動印刷ルーチンを作成し流したところ概ねうまくいきました。
いちい保存先を指定して保存する作業に関しては、acrobat上の設定で前もって保存先を指定しておくことで回避できました。

そもそも、保存先をアクロバットで指定できることがスパッと頭から抜け落ちていました。

ファイル移動のひと手間は増えましたが、３０００枚近くのものを一括でpdf化できました。

ご回答ありがとうございました。

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
以下　コード

Sub BAPforPDF()
Dim MyFile As String, MyPath As String
Dim wb As Object
Dim WT1 As Variant, WT2 As Variant
Dim fn As String

If vbNo = MsgBox("フォルダ内のブックの一括印刷を行いますか？", vbYesNo) Then GoTo CloseFile

Dim bookname1 As String
bookname1 = "ZConv.xls"

'MsgBox "Process1"

'ブックパスの取得及びファイルのオープンメソッド
MyPath = ThisWorkbook.Path & "\" '自分のパスを取得
MyFile = Dir(MyPath & "*.xls", vbNormal) 'パス内のxlsファイル

If LCase(MyFile) = LCase(bookname1) Then MyFile = Dir 'MyFileとbookname1が同じファイルの場合スキップする
Do Until MyFile = "" '対象ファイルがなくなるまで
Set wb = Workbooks.Open(MyPath & "\" & MyFile) '選択したファイルを開く

'アクティブシートの印刷設定をPDFに変更する。
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "$A$1:$BV$53"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.78740157480315)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
End With

WT1 = Now + TimeValue("0:00:02")
Application.Wait WT1

'アクティブシートを印刷する。
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

WT2 = Now + TimeValue("0:00:03")
'If vbNo = MsgBox("Run for Waiting?", vbYesNo) Then GoTo CF
Application.Wait WT2

CF:
'※変更を保存せずに閉じる場合は(1)のコードをアクティブに、保存して閉じる場合は(2)のコードをアクティブにすること！
'※検証の際は(3)をアクティブにすること！

'(1)アクティブブックの変更を保存せずに閉じる。
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True

'(2)アクティブブックの変更を保存して閉じる。
' ActiveWorkbook.Save
' ActiveWorkbook.Close

'(3)別名で保存
'fn = MyPath & "Pr\PDF-" & (Range("J4").Value)
' ActiveWorkbook.SaveAs Filename:=fn
' ActiveWorkbook.Close

MyFile = Dir '次のファイルを検索
If LCase(MyFile) = LCase(bookname1) Then MyFile = Dir 'MyFileとbookname1が同じファイルの場合スキップする
Set wb = Nothing

Loop '繰り返し
GoTo ProcessEnd

'Msgbox "Process9"

CloseFile:

ActiveWorkbook.Close
MsgBox "処理を中止しました。"
Exit Sub

ProcessEnd:

MsgBox "処理が終了しました"

End Sub

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

回答No.1

temtecomai2

残念ながら
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, PrtoFileName:=fn
でやってることは、印刷ダイアログにある 「ファイルへ保存」 にチェックを入れて、保存先を指定しているのと同じ。
それで保存されたファイルは PDF ではなく、一般的なプリンターで汎用的に読み込んで印刷できる形式のファイル。
http://www.nikkeibp.co.jp/archives/104/104162.html

Office 2007 か Office 2010 なら Acrobat 不要で PDF 出力ができ、当然ながら VBA からもコントロールが可能。
下記は Excel 2007 ん時に作ってみたやつ。
http://blog.temtecomai.net/archives/51144291.html

Office 2003 以前なら Acrobat 以外の PDF 出力プリンターを使うのが一般的か。(要求そのものがあまり一般的ではないと思うけど)
http://d.hatena.ne.jp/morningmist7/20080623/1214216982
Acrobat を使って無理やり PDF 出力するサンプルもあった。
http://note.phyllo.net/?eid=1106046

お礼

＜自己解決＞
acrobatを通常使うプリンターに設定し、通常の自動印刷ルーチンを作成し流したところ概ねうまくいきました。
いちい保存先を指定して保存する作業に関しては、acrobat上の設定で前もって保存先を指定しておくことで回避できました。

やはり、.pdfという拡張子を無理やりつけただけのファイルとなっていたのですね。
アクロバットの設定を確認して利用したところ、通常の印刷ルーチンで望む結果が得られました。

ご回答ありがとうございました。