pdf印刷時に登録ファイル名の確認を無効化したい

このQ&Aのポイント
  • Excel 2010でPDFファイル化する際に、ファイル名の確認を無効にする方法について
  • Excelマクロを使用してPDFファイル化する際に、ファイル名の入力を省略する方法について
  • PDF印刷時にファイル名の確認をスキップする方法について
回答を見る
  • ベストアンサー

pdf印刷時に登録ファイル名の確認を無効化したい

excel2010 TESTフォルダ内にある。全てのexcelフィルをcutepdfwriterでpdfファイル化しようとしています。 マクロ Sub test() Application.DisplayAlerts = False Dim Fol As String Dim Fname As String Dim Ws As Worksheet Fol = "C:\test" Fname = Dir(Fol & "\*.xlsm") Do While Fname <> "" If Fname <> ThisWorkbook.Name Then Workbooks.Open Fol & "\" & Fname For Each Ws In Worksheets Ws.PrintOut Next Workbooks(Fname).Close SaveChanges:=False End If Fname = Dir() Loop End Sub で実施するとファイルを開いてpdfファイルを作成可能なのですが、 各々のファイルに対して、名前をつけて保存 ファイル名.pdf と聞いてきます。 その都度、保存というボタンをクリックする必要があり、 大量のファイル実施時、手間です。 なお、cutepdfwriterを通常使うプリンタに設定しています。 この保存というボタンをクリックしないで、ファイル名をそのままでpdfファイル化する方法は、 ありますでしょうか?

質問者が選んだベストアンサー

  • ベストアンサー
回答No.5

Pnameの値の変化を追ってゆけば (コード上で F9 、後は F8 でステップ実行)すぐに確認できたのに。 前略 'ファイル名17桁取得 ’Pname = Left(Fname, 17) 下記のループ内に移動 ' Do While Fname <> "" 'ファイル名17桁取得 Pname = Left(Fname, 17) 'ここへ移動しました If Fname <> ThisWorkbook.Name Then Workbooks.Open Fol & "\" & Fname For Each Ws In Worksheets ' Ws.PrintOut ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "C:\test\" & Pname, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ False Next '下記指定をしないと登録フォルダのファイル先頭1つファイルしかpdf化されない ’Pname = Left(Fname, 17) これは不要 Workbooks(Fname).Close SaveChanges:=False 後略 ExportAsFixedFormat は既存同名ファイルがあっても 確認メッセージは出さずに上書きします。

3620313
質問者

お礼

ばっちりでした。ありがとうございます。 ”コード上で F9 、後は F8 でステップ実行”のあたりは、勉強します。

その他の回答 (4)

回答No.4

>登録ファイルが1つでも”名前をつけて保存”が表示されます。 なるほど、私の使わせてもらっているBullzip PDF Printer とは動作が異なるようですね。 せっかくなので自BookのワークシートをPDF出力するサンプルを載せときます。 少しは参考になるかと思います。 投稿用にタブインデントの代わりに全角スペースを代用しています。 フォルダ内全てとなるとパスワードありのファイルやAUTO_OPEN / WorkBook_Openも 考慮する必要もあるかもしれませんね。 Sub PDFout()   Dim i As Long   Dim SHs   Dim SHcurrent As Worksheet      If Application.Version < "12.0" Then     MsgBox "この機能はExcel2007以降でのみ使用出来ます"     Exit Sub   End If      Set SHcurrent = ActiveSheet   ReDim SHs(Worksheets.Count - 1)      '拡張子違いで同名ブックの対応未決定   For i = 1 To Worksheets.Count     'ワークシートごとに出力     If WorksheetFunction.CountA(Worksheets(i).Cells) <> 0 Then '空白シート除外       Worksheets(i).ExportAsFixedFormat Type:=xlTypePDF, _         FileName:=ThisWorkbook.Path & "\" _         & Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1) _         & "-" & Worksheets(i).Name & ".pdf", _         Quality:=xlQualityStandard, _         IncludeDocProperties:=True, _         IgnorePrintAreas:=False, _         OpenAfterPublish:=False     End If          '全ワークシートをまとめて一つのPDFにするために配列に格納     SHs(i - 1) = Worksheets(i).Name   Next   Worksheets(SHs).Select '空白シートは自動的に印刷出力対象にはならない様子   ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _     FileName:=ThisWorkbook.Path & "\" _     & Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1) _     & "(" & Worksheets.Count & ").pdf", _     Quality:=xlQualityStandard, _     IncludeDocProperties:=False, _     IgnorePrintAreas:=False, _     OpenAfterPublish:=False      SHcurrent.Select   Set SHcurrent = Nothing End Sub

3620313
質問者

お礼

ありがとうございます。

3620313
質問者

補足

大変参考になりました。 cutepdfへ印刷すると、名前を付けて保存が表示される仕様みたいなので、 cutepdfへの出力を廃止しました。 代わりに、教えていただいた参考マクロのActiveSheet.ExportAsFixedFormat Type で代用してみました。 下記test1のマクロで名前をつけて保存のポップアップは、聞かれなくなりました。 しかしながら、 *****************.xlsm.pdf の様に登録されるのがちょっと気になりました。 *はファイル名17桁です。 Sub test1() Application.DisplayAlerts = False Dim Fol As String Dim Fname As String Dim Ws As Worksheet Fol = "C:\test" Fname = Dir(Fol & "\*.xls*") Do While Fname <> "" If Fname <> ThisWorkbook.Name Then Workbooks.Open Fol & "\" & Fname For Each Ws In Worksheets 'cutepdfへの出力廃止 ' Ws.PrintOut 'pdfで保存 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "C:\test\" & Fname, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ False Next Workbooks(Fname).Close SaveChanges:=False End If Fname = Dir() Loop End Sub なので、ちょっと変更してみました。 Sub test2() Application.DisplayAlerts = False Dim Fol As String Dim Fname As String Dim Pname As String Dim Ws As Worksheet Fol = "C:\test" Fname = Dir(Fol & "\*.xls*") 'ファイル名17桁取得 Pname = Left(Fname, 17) ' Do While Fname <> "" If Fname <> ThisWorkbook.Name Then Workbooks.Open Fol & "\" & Fname For Each Ws In Worksheets ' Ws.PrintOut ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "C:\test\" & Pname, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ False Next '下記指定をしないと登録フォルダのファイル先頭1つファイルしかpdf化されない Pname = Left(Fname, 17) Workbooks(Fname).Close SaveChanges:=False End If Fname = Dir() Loop End Sub test2のマクロで *****************.pdf というファイル名で保存される様になり、ほぼほぼやりたい内容は実現できたのですが、登録されているファイルの最後が保存できない状況です。 4つのxlsmファイルを登録していたら3つしかpdfができない。 test1のマクロは、4つのxlsmファイルで4つのpdfができます。 どこが悪いのか、分かりましたら、教えていただきたく。

回答No.3

ここで For Each Ws In Worksheets Ws.PrintOut Next としていますから拡張子を除いたブック名 & .pdf で保存されているわけです。 ワークシートが複数の場合に二番目以降は上書きの確認が出ているのでは? QutePDF Writer に既存ファイルがある場合は後ろに連結する・・・ような オプションでもない限り。 (QutePDF Writer は使ったことはありません。) Excel2007以降ならPDFでも保存できるようになったので QutePDF Writer 独自の機能が必要でなければ、そっちで・・・。 全てのExcelファイルを対象と考えているのなら Fname = Dir(Fol & "\*.xlsm") でマクロ有効ファイルだけを選択しているのも気になります。 "\*.xls*" では?

3620313
質問者

お礼

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

3620313
質問者

補足

ワークシートが複数の場合に二番目以降は上書きの確認が出ているのでは? → 登録ファイルが1つでも”名前をつけて保存”が表示されます。 acrobat writerが入っているパソコンで印刷設定しても同じでした。 Excel2007以降ならPDFでも保存できるようになったので → 調べてみます。 Fname = Dir(Fol & "\*.xlsm") でマクロ有効ファイルだけを選択しているのも気になります。 "\*.xls*" では? → testフォルダに登録しているファイルの拡張子が全てxlsmだったのです。 特に意識していたわけではありません。

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.2

質問の核心ではないですが、質問のコードが適当ですか? >ファイルを開いてpdfファイルを作成可能なのですが PDFファイウルで保存のコードは質問のコードにないのでは。  参考 「VBA エクセル pdfファイルで保存」でGoogleで照会してみたら その最初の http://excel.style-mods.net/tips_vba/tips_vba_8_11.htm など。 >cutepdfwriterを通常使うプリンタに設定しています。 参考 同じく cutepdfwriterで照会したら。 http://stackoverflow.com/questions/33101788/print-all-sheets-through-cutepdf-writer がある。 ーー >Fname <> ThisWorkbook.Name Then 開くファイル名が決まっているのに、なぜDir関数をDo-Loopで繰り回して探すのかわからなかった。

3620313
質問者

お礼

回答ありがとうございます

3620313
質問者

補足

PDFファイルで保存のコードは質問のコードにないのでは に対しては、 Ws.PrintOut の部分で印刷出力しています。 cutepdfwriterを通常のプリンタで指定しておくと、excelから印刷することでpdfファイルが作成できます。 excelで印刷=pdfで保存 という構成になります。 開くファイル名が決まっているのに、なぜDir関数をDo-Loopで繰り回して探すのかわからなかった。 → 1つのフォルダ内に登録したexcelファイルを全てpdfにしたいのです。 上記マクロはWEBに掲載されていたものをそのまま流用してます。

  • chie65535
  • ベストアンサー率43% (8519/19367)
回答No.1

>方法は、ありますでしょうか? 質問者さんの方法は「印刷するとpdfファイルが作成される、仮想プリンタに印刷する」という方法で、pdf化しています。 システム的には「Excelの制御を離れ、プリンタ出力を行なっているだけ」なので、Excelの側から何らかの操作をする事は出来ません。 つまり「ファイル名をそのままでpdf化する事はできない」です。

3620313
質問者

お礼

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

3620313
質問者

補足

Excelの側から何らかの操作をする事は出来ません。 だとすると、保存する名称が表示されるのは回避できないということですね。 なお、 「ファイル名をそのままでpdf化する事はできない」に関しては、違ってます。 cutepdfwriterで印刷すると、excelファイル名のxlsxより前の部分でpdfのファイル化されます。 test.xlsx を印刷すると test.pdf で保存と聞いてきます。 なので、ファイル名をそのままpdf化はできています。 1件1件保存の確認ポップアップがでなくなればというおもいです。 補足まで。

関連するQ&A

  • ActiveWorkBook VBA

    Sub test() Dim myCSV As String Dim Fname As Variant Dim Aname As String Dim Fullp As String Application.ScreenUpdating = False Fullp = ActiveWorkbook.FullName Pos = InStrRev(Fullp, "\") Fname = Left(Fullp, Pos) myCSV = Dir(Fname & "*.csv") Do Until myCSV = "" Workbooks.Open Fname & myCSV Aname = Left(Fullp, InStr(1, Fullp, ".") - 1) ActiveWorkbook.SaveAs filename:=Aname & ".xls", FileFormat:=xlExcel9795 ActiveWorkbook.Close myCSV = Dir() Loop Kill Fname & "*.csv" End Sub あるフォルダにあるcsvファイルをxlsで保存したいと思いましたが、アクティブになるBOOKがバラバラ? で、うまくいきません。csvファイルを開いたときに そのファイルがアクティブになり、うまくloopできないでしょうか?

  • 複数フォルダにある複数ファイルの一括印刷

    下記の通りフォルダの中にある、複数のエクセルファイルを印刷するマクロを使用しています (どこからか、参考にして自分なりに変更したら、出来たのですが・・・) 一つのフォルダに存在する複数フォルダの複数ファイルを、上記同様に印刷する方法は どのようにすればよいのでしょうか?(フォルダは30個位、ファイル1~20個位、増減あり) どなたか、お知恵をお貸しください。お願いいたします。 Sub test() ' ' 印刷マクロ ' Dim fol As String Dim f As String Dim wb As Workbook Dim wscnt As Long Dim i As Long fol = "d:\sampul" f = Dir(fol & "\*.xls") Do While f <> "" Set wb = Workbooks.Open(fol & "\" & f) wscnt = wb.Worksheets.Count For i = 1 To 1 wb.Worksheets(i).PrintOut Next i wb.Close f = Dir() Loop Set wb = Nothing End Sub

  • エクセルVBAでのエラー

    おはようございます。 昨日ここでいろいろ教えていただき、300のエクセルファイルから特定の範囲のデータ抽出方法を書いてみたのですが、セルが多すぎて実行できません、というエラーがでてしまいます。 これはどのように解消すればよろしいのでしょうか? Sub Test() Dim FPath1 As String, FPath2 As String Dim FName As String, myBook As String Const startROW As Long = 14, lastROW As Long = 20 Const startCOL As Long = 8, lastCOL As Long = 10 Const shtNAME As String = "sheet1" Application.ScreenUpdating = False FPath1 = "D:\MR5567\" FPath2 = "D:\New Microsoft Excel Worksheet\" Workbooks.Add myBook = ActiveWorkbook.Name FName = Dir$(FPath1 & "*.xls") Do While FName <> "" Workbooks.Open Filename:=FPath1 & FName ActiveWorkbook.Sheets.Select Sheets(1).Activate Sheets.Copy After:=Workbooks(myBook).Sheets(Sheets.Count) Workbooks(FName).Activate Application.DisplayAlerts = False ActiveWorkbook.Close FName = Dir$ Loop ActiveWorkbook.SaveAs Filename:=FPath2 & "Renketsu.xls", FileFormat:=xlNormal ActiveWorkbook.Close Application.ScreenUpdating = True End Sub

  • ファイル名を合成すると検索できないのでしょうか?

    下記のような式がありまして、一度作成したファイルは上書きされないはずですが何回やっても上書きされてしまいます。 これはファイルを検索していないのでしょうか? 既にファイルがあったら終了するはずですが何か間違えていますか? 'ファイル作成 Sub MakeCopyFile(newfile As String, orgfile As String) If SearchFile(newfile) Then Exit Sub End If Set fs = CreateObject("Scripting.FileSystemObject") fs.CopyFile orgfile, newfile End Sub ' ファイル検索 Function SearchFile(fname As String) As Boolean SearchFile = False Set fs = Application.FileSearch With fs .Filename = fname If .Execute() > 0 Then SearchFile = True End If End With End Function Sub Macro1() Dim name As String '名前 Dim fname As String 'ファイル名 Dim directory As String '作成先ディレクトリ Dim fullpath As String 'フルパス Dim orgfile As String '雛形のファイル名 Dim editbook As Workbook '個人データブック Dim id As String '番号 directory = "H:\test\" orgfile = "H:\test\雛形.xls" For i = 1 To 100 name = ThisWorkbook.Worksheets("Sheet2").Cells(i, 10).Value id = ThisWorkbook.Worksheets("Sheet2").Cells(i, 12).Value If name = "" Then Exit For End If 'コピーしたファイルを作成する fname = name + id + ".xls" 'ファイル名合成 fullpath = directory + fname 'フルパス合成 Call MakeCopyFile(fullpath, orgfile) 'ファイル作成 Workbooks.Open Filename:=fullpath Set editbook = Workbooks(fname) editbook.Worksheets("Sheet3").Cells(8, 14).Value = name editbook.Worksheets("Sheet3").Cells(8, 10).Value = id '※(その他必要な処理があれば追加してください) editbook.Close (True) Next i End Sub

  • VBAでESCキーを無効にしたいのですが、うまくいきません。

    EXCEL VBA でESCキーを無効にするために、 Application.EnableCancelKey = xlDisabled を使用していますが、 特定のフォルダ内のEXCELファイルを開いて、ある処理をして保存するといったプログラムでは、ESCキーを無効にすることができませんでした。 原因を探るために以下のテストプログラムを作成しましたが、実行中にESCキーを押すと(長押しすると確実に) 「実行時エラー'1004' openメソッドは失敗しました。'Workbooks'オブジェクト」 のメッセージが表示されて止まってしまいます。 どこに原因があるのでしょうか? よろしくお願いします。 以下、テストプログラム ////////// Private Sub CbStart_Click() Dim Fname As String Dim Fpath As String Application.ScreenUpdating = False Application.EnableCancelKey = xlDisabled Fpath = "d:\work\" Fname = Dir(Fpath & "*.xlsx") Do While Fname <> "" Workbooks.Open Fpath & Fname CloseWorkbook Fname Fname = Dir() Loop Application.ScreenUpdating = True End Sub 以上 //////////////////

  • マクロでファイル名(を含む)を検索しPDFを開く

    マクロでファイル名(セルの値)を含むPDFファイルを検索し、ファイルが存在していればそのファイルを開きたいのですがうまく行きません。 Sub を含むPDFファイルを開く() Dim keyword As Variant Dim myPath As Variant Dim fName Dim pname Set my = ActiveSheet keyword = my.Range("D2").Value '検索する値 myPath = my.Range("F1").Value  'フォルダパス fName = Dir(myPath & "*" & keyword & "*" & ".pdf") pName = (myPath & "*" & keyword & "*" & ".pdf")  '"*" & keyword & "*"が良くないのだと思います。 If fName = "" Then MsgBox ("該当するファイルが存在しません。") Exit Sub End If With CreateObject("Wscript.Shell")  .Run pname, 5  'ここでエラーが出ます。 End With End SUB 'pname内の"*" & keyword & "*"をkeywordのみにすると完全一致のファイルは開けるのですが部分一致で開きたいため”*”を使用したところエラーが出てしまいます。 また、検索するPDFファイルにスペースが含まれていても開けるようにしたいのです。 どうかご指導のほうをよろしくお願いします。

  • 新しく開いたブックをアクティブにするマクロ

    マクロ 新しく作ったブックをアクティブにする マクロ初心者です。 マクロを使って同階層にあるファイルのアクティブのシートを ひとつのブックにコピーして保存するマクロを作りたいと思ってます。 他の質問を参照して下記のコードを途中まで作成しました。 参照した質問では、 マクロの入っているブックにシートをコピーするようでしたが、 そうすると保存した時にマクロも保存されてしまうので 私なりに調べて、新しいブックにシートコピーするようにしましたが、 この記述の後、新しいブックをアクティブにする記述がわからず、 保存できなくなってしまいました。 ここまで終わるとマクロの入っているブックがアクティブになって終わります。 このあと新しく開いたブックをアクティブにして、 ブックのsheet1~3を削除して、名前をつけて保存したいのですが 開いたブックをアクティブにするマクロをご伝授ください。 あたらしくブックをつくるとbook1~・・・と名前が変わってしまうので 変数で名づけたいのですが、やり方が良くわかりませんのでよろしくお願いします。 何卒よろしくお願いします。 Sub consolid_test() Dim shCnt As Integer Dim Wb As Workbook Dim i As Integer Dim sh As Worksheet Dim nSh As Worksheet Dim fName As String Dim ka As String Application.ScreenUpdating = False '画面更新を一時停止 Application.DisplayAlerts = False Set mb = Workbooks.Add '新しいコピー先ブックをmbとする。 myfdr = ThisWorkbook.Path fName = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索 Do Until fName = Empty '全て検索 If fName <> mb.Name Then 'ブック名がこのブックの名前でなければ Set Wb = Workbooks.Open(myfdr & "\" & fName) 'そのブックを開きwbとする。 Wb.ActiveSheet.Copy After:=mb.Sheets(mb.Sheets.Count) 'コピーしてコピー先ブックの末尾に置く ActiveSheet.Name = Range("B16") 'シート名の変更 ActiveSheet.Unprotect 'シート全体をコピーして値にする Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Wb.Close (False) '保存の有無を聞かずに保存しないで閉じる N = N + 1 'ブック数をカウント End If fName = Dir 'フォルダ内の次のExcelブックを検索 Loop '繰り返す ・ ・ ・ ・

  • 指定フォルダ内のファイルオープン→別フォルダに同じファイル名のcsvとして保存 のマクロを作ろうとしています

    エクセルで、指定フォルダ内のファイルオープン→別フォルダに同じファイル名のcsvとして保存 のマクロを作ろうとしています。 現在下記のようなマクロを途中まで作成したのですが、保存の良い方法が分からず困っております。 (ファイルオープンまでは出来ているようですが、その後エラーが出てしまいます) どなたかお知恵を拝借願えませんでしょうか。 どうぞ宜しくお願い致します。 Sub Book_Open() Dim BookName As String Dim PathName As String PathName = "C:\test_htmltocsv\test\" BookName = Dir(PathName & "*.html") Do Until BookName = "" Workbooks.Open PathName & BookName BookName = Dir() ActiveWorkbook.SaveAs "Sample.xls" ←← Loop End Sub

  • 指定したセルでファイル名を保存するマクロについて

    マクロ初心者です。 A1セルの文字をファイル名にして保存する方法を知りましたが、A1セルとB1セルの文字をファイル名にして保存したい場合、どのようにすれば良いか分かりません。 A1セルに企業コード、B1セルに企業名です。 ファイル名を「請求書(13579いろは株式会社様)」としたいのです。 実際のマクロを一部抜粋しますが、下記の場合はファイル名は 「請求書(13579様).xls」となります。 Dim WS As Worksheet Dim fname As String fname = "C:\保存先\" & ("請求書(") & WS.Range("a1").Value & ("様)") & ".xls" どなたか教えて下さい。 どうぞよろしくお願い致します。

  • ファイル名のわからない複数のファイルをひとつにまとめる

    エクセル2000で以下のマクロを作成したいです。 1.フォルダ内のCSVファイルを開き、中のデータをひとつにまとめる。 (フォルダ名とファイル名、ファイル数はその時によって変わってきます。ファイル数はだいたい10個くらいです。ひとつのデータは20列50行くらいで列の項目を基準にまとめたいです。) 2.列を1列目に挿入し、2列目と3列目のデータを1列目に統合する。 3.1列目のデータを使用し、重複を調べる。重複がある場合はどちらかひとつを削除する。(できれば4列目のデータを比較し数値が少ないほうを削除したいです。) まだ途中までですが、マクロ作成してみました。 わたしとしては、フォルダ内のCSVファイルを開いてセルA1からデータの入った範囲をコピーし、testエクセルファイルのアクティブセルに貼り付け ↓↓↓ 次のファイルのデータをその下に貼り付けたいのでtestファイルのデータが入ったセルの下を選択し、ファイルを開くへ繰り返し。 のつもりなのですが…、うまく作動しません。 マクロのテキストを片手にネットでも検索しながら作ったのですが、まだ記述の仕方などがわかってなくどこがおかしいのかもわかりません。 わかる方がいたらよろしくお願いします! ----------------------------------- Sub ファイルのデータを統合() Dim filename As String Dim openedbook As Workbook Dim isbookopen As Boolean Dim myworksheet As Worksheets Dim myrange As Range filename = Dir(ThisWorkbook.Path & "\*.csv") Do While filename <> "" isbookopen = False For Each openedbook In Workbooks If openedbook.Name = filename Then isbookopen = True Exit For End If Next Range("A1").CurrentRegion.Copy Destination:=Workbooks("test.xls").Worksheets("sheet1").ActiveCell Workbooks("test.xls").Worksheets("sheet1").Range("A1").End(xlDown).Offset(1).Select If isbookopen = False Then Workbooks.Open (ThisWorkbook.Path & "\" & filename) End If filename = Dir() Loop End Sub

専門家に質問してみよう