エクセルブックを一括で名前をつけて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
A 回答 (2件)
- 最新から表示
- 回答順に表示
No.2
- 回答日時:
本家Acrobatをお使いなら、下記がご参考になるでしょう。
http://okwave.jp/qa/q6205938.html
フリーソフトなら、
pdfcreatorをお勧めします。
http://sourceforge.jp/projects/pdfcreator/
一部しか試してないですが、下記にExcel VBAのサンプルコードがあります。
http://www.excelguru.ca/node/21
<自己解決>
acrobatを通常使うプリンターに設定し、通常の自動印刷ルーチンを作成し流したところ概ねうまくいきました。
いちい保存先を指定して保存する作業に関しては、acrobat上の設定で前もって保存先を指定しておくことで回避できました。
そもそも、保存先をアクロバットで指定できることがスパッと頭から抜け落ちていました。
ファイル移動のひと手間は増えましたが、3000枚近くのものを一括で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
- 回答日時:
残念ながら
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/1214 …
Acrobat を使って無理やり PDF 出力するサンプルもあった。
http://note.phyllo.net/?eid=1106046
<自己解決>
acrobatを通常使うプリンターに設定し、通常の自動印刷ルーチンを作成し流したところ概ねうまくいきました。
いちい保存先を指定して保存する作業に関しては、acrobat上の設定で前もって保存先を指定しておくことで回避できました。
やはり、.pdfという拡張子を無理やりつけただけのファイルとなっていたのですね。
アクロバットの設定を確認して利用したところ、通常の印刷ルーチンで望む結果が得られました。
ご回答ありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
歩いた自慢大会
「めちゃくちゃ歩いたエピソード」を教えてください。 長時間でも長距離でも結構です。
-
フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
あなたが普段思っている「これまだ誰も言ってなかったけど共感されるだろうな」というあるあるを教えてください
-
映画のエンドロール観る派?観ない派?
映画が終わった後、すぐに席を立って帰る方もちらほら見かけます。皆さんはエンドロールの最後まで観ていきますか?
-
海外旅行から帰ってきたら、まず何を食べる?
帰国して1番食べたくなるもの、食べたくなるだろうなと思うもの、皆さんはありますか?
-
天使と悪魔選手権
悪魔がこんなささやきをしていたら、天使のあなたはなんと言って止めますか?
-
VBA PDFで保存するマクロで実行時エラー 1004
Visual Basic(VBA)
-
エラー1004 PDFの保存ができません。解決方法を教えてください。
Visual Basic(VBA)
-
vbaでPDFファイルが印刷されない
Visual Basic(VBA)
-
-
4
マクロ、PDFを任意のフォルダへ保存
Excel(エクセル)
-
5
Excelマクロのエラーを解決したいです。
Visual Basic(VBA)
-
6
PDFファイルが破損していると表示されて
ホームページ作成・プログラミング
-
7
エクセルをPDFで保存し、ファイル名はA1セルを参照するVBAの記述を教えてください。
Excel(エクセル)
-
8
Excel VBAでPDFファイルをMicrosoft Print to PDFで出力したい
Visual Basic(VBA)
-
9
エクセル:マクロ「Application.CutCopyMode = False」って?
Excel(エクセル)
-
10
Excel VBA シートを指定してpdf化
Visual Basic(VBA)
-
11
Application.ScreenUpdating = Falseが効きません
Visual Basic(VBA)
-
12
VBA★PDFをPDFアプリで印刷しようと思っていますが上手くゆきません
Visual Basic(VBA)
-
13
エクセルのエラーメッセージ「400」って?
Visual Basic(VBA)
-
14
「Columns(A:C")」の列文字を数字にして表記したい"
Excel(エクセル)
-
15
VBA エンターキーでイベントに入りたい。
PowerPoint(パワーポイント)
-
16
マクロで印刷時のポートについて
Access(アクセス)
-
17
VBAでブックを非表示で開いて処理して閉じる方法
Excel(エクセル)
-
18
特定のPCだけ動作しないVBAマクロがあります。その理由は?
Visual Basic(VBA)
-
19
VBAで保存しないで閉じると空のBookが残る
Excel(エクセル)
-
20
Mac版 Excel VBA PDF出力フォルダについて お世話になります。 MicrosoftOf
Excel(エクセル)
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
vbaサブフォルダーをワイルドカ...
-
ffftpでファイル取得が0バイト...
-
AccessからOLEオブジェクト型の...
-
コモンダイアログでフォルダを...
-
サブフォルダ含むフォルダ内の...
-
Vb6.0ランタイム―FlexGridとカ...
-
VBAでフォルダ内のhtmlファイル...
-
動かなくなってしまった古いVBA...
-
VBA、ファイル名検索から開く、...
-
Accessのウインドウサイズの固定
-
VBAで色々な種類のファイルを開く
-
vbs ブック共有を解除
-
「AccessViolationException」...
-
ファイルを複数選択した時のフ...
-
FTP対応のアプリケーション
-
【ACCESS VBA】アクセスからデ...
-
VBからExcelファイルを開くとき...
-
FileDialog オブジェクトでファ...
-
inetコントロールを使用したFTP...
-
EXCEL VBAを使ったファイル解析...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
サブフォルダ含むフォルダ内の...
-
vbaサブフォルダーをワイルドカ...
-
FileDialog オブジェクトでファ...
-
動かなくなってしまった古いVBA...
-
ffftpでファイル取得が0バイト...
-
excel マクロ PDF化の際のエラ...
-
「エクセルファイルが開いてい...
-
VBAでCSVファイルを読み込もう...
-
VBからExcelファイルを開くとき...
-
vbsでのアスタリスクとファイル...
-
VBAでフォルダ内のhtmlファイル...
-
エクセルのVBAで開いている...
-
VB6でUTF-8ファイルの読取りを
-
EXCEL VBAを使ったファイル解析...
-
AccessからOLEオブジェクト型の...
-
タイムスタンプの更新の方法2
-
ExcelVBA 文字コード変換
-
複数のワークブックのVBAを変更...
-
VBAでのファイル名と更新日(作...
-
ファイルを開く時間測定のスク...
おすすめ情報