[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『excel マクロ PDF化の際のエラーについて』（silber_luchs）
Soft:Excel2003,Adobe Acrobat9.0Sandard OS:Windows XP SP3 マクロファイル：Conv.xls
エクセルブックを一括で名前をつけて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
他のサイトでの回答例です。
http://okwave.jp/qa/q6991476.html
（じゅんじゅん）
（silber_luchs）
ずいぶん質問をあちこちにばら撒きましたね～。 ↑でリンクした以外にもたくさんありましたね。
一般にQ&Aサイトではマルチポストは禁止しているところが多いです。 禁止されていないところでも容認しているだけで推奨しているわけではない です。 マルチポスト禁止サイトではマルチポストしてはいけませんし、容認してい るサイトでも他のサイトでも投稿している旨を記載するのがマナーです。
[Tips]マルチポストが嫌われる理由～なぜマルチポストは問題か？ ハマる生活/ウェブリブログ http://stakasaki.at.webry.info/200512/article_3.html
(シスボーベー)
非常に急いでおり、マルチポスト云々といわれても知ったことじゃないです。
そもそも質問に対する回答をしてくれる気がないなら、余計な回答はいりません。
ばら撒いたわけではなく、質問をしても求めるレスポンスが得られない為、より広い範囲で回答を求める為に行っているわけで、それをあなたが不快と思われるのであれば、それに対してレスポンスをしなければいいだけではないかと私は思います。
リンクのページを読みましたが、どうしてもだめな理由として私が求めている方法がそれに当るとは思えません。
この質問が不快と思われるのであれば答えてくださらなくて結構です。
（silber_luchs）
保存先のパスまでいちいち指定させて、見かけ上pdfファイルを作るコードではうまくいかないようでした。
そもそも、保存先をアクロバットで指定できることがスパッと頭から抜け落ちていました。
ファイル移動のひと手間は増えましたが、３０００枚近くのものを一括で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:
'※変更を保存せずに閉じる場合は①のコードをアクティブに、保存して閉じる場合は②のコードをアクティブにすること！
'※検証の際は③をアクティブにすること！
'①アクティブブックの変更を保存せずに閉じる。
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
'②アクティブブックの変更を保存して閉じる。
' ActiveWorkbook.Save
' ActiveWorkbook.Close
'③別名で保存
' 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
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
（silber_luchs）
コードを整形しました。内容は変えてません。 各サイトでご自身の検証結果の報告をされている姿勢は評価できますが、 急いでいない時、忙しくない時にでも、シスボーベーさんが紹介されたサイトを ゆったりとした気持ちで、何度でも参照される事をお勧めします。 それこそ一年後、二年後、五年後でも。その時々で感じ方も変わってるでしょうし。 少なくとも私は今回こういった質問をされる方に対して、 その質問に対する良い回答をもっていたとしても、 快くそれを提示する気持ちにはなれません。 今回はご自身で解決出来たので良かったですが、 今後もし同じような場面があったとして、急ぎ回答を得たい状況があった時、 「マルチだなんだ」といった煩わしいやり取りで時間を費やす事を避ける為にも。 （この今の私の書き込みすら無駄なやり取りに相当すると思いますし） って感じました。おわり。 （ご近所PG）
盗人猛々しいとはこのことですね。
自動車で走っているとき、急いでいるからといって 通行人を撥ねてもいいということはないですよね。
呆れてものも言えない、というかんじです。 二度とネット上に顔を出さないでほしいですね。
実社会でも同じ感じなのでしょうね。こういう人は。
(シスボーベー)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.