エクセルを選択して開き印刷するマクロ

質問

お世話になっております。
タイトル通りのマクロの作成をしているのですが、行き詰ってしまい質問させていただきました。

説明させていただきますと、、
実行し、複数のエクセルbookを選択し開くとシートを全選択し通常使うプリンタで印刷をする。というマクロなんですが、改善していきたい事がありまして、助言をいただきたく思っております。

1.複数選択して開いても印刷されるのは開いた後アクティブになっているbookのみ。これを全て開いたbook印刷にしたい。
2.現在は通常使うプリンタで印刷するようにしていますが、複数選択し開いた時に始めの1回だけプリンタの設定画面になるようにしたい。
3.開いて印刷し閉じるだけなのにリンクなどが残っており、「保存しますか？」という文章が出るときがありますが、それを聞かれないように保存せずに閉じる。と自動的に実行してくれる。

２と３は、出来ればそうなってほしいという事なので、最重要は１番です。120個のエクセルを（１つあたりの容量は少ない）印刷しなければならないので困っております。一気に120個印刷かけるわけではなく10個位を分けてマクロ実行で印刷しようと思っております。
コードを載せさせて頂きますので、「ココをこう直せば出来るよ」など簡単な事でも結構ですのでアドバイスよろしくお願いいたします。
-----------------------------------------------------------
Sub 複数のファイルを選択して開く_エクセル版()

'複数のファイルを選択する例

Dim vntFileName As Variant
Dim vntGetFileName As Variant

'ファイルを開くダイアログを開きます
vntFileName = _
Application.GetOpenFilename( _
FileFilter:="エクセルファイル(*.xls),*.xls" & _
",CSVファイル(*.csv),*.csv" _
, FilterIndex:=1 _
, Title:="印刷するファイルを選択" _
, MultiSelect:=True _
)

'ファイルが選択されているとき(vntFileNameが配列型)は
'選択した全てのファイルをWorkbooks.Openメソッドを使い開きます。
If IsArray(vntFileName) Then
For Each vntGetFileName In vntFileName
Workbooks.Open vntGetFileName
Worksheets.Select 'シート全選択
Next
ActiveWindow.SelectedSheets.PrintOut Copies:=1 '通常設定のプリンタで出力
End If
ActiveWindow.Close 'ファイルを閉じる
End Sub

回答No.4

Wendy02 · ベストアンサー

こんばんは。

>OKと答えると印刷設定画面が出るのを、どこか他のコードとのセットにしてみる。
>Application.Dialogs(xlDialogPrint).Show　

自分自身で、調べるべきでした。よく考えずに、そのダイアログを使ってしまいました。そのダイアログは間違いです。

改良点：
Application.Dialogs(xlDialogPrintSetUp).Show　で、プリンタの設定だけにさせました。
たぶん、こちらで上手くいくと思います。

DoEvents で、Escキーによる割り込み終了を可能にしました。数回押せば、マクロが止まります。

このオプションは、大量に印刷する時に、万が一にも間違いに気づいたときに、少しでも、印刷の無駄を回避できるように考えました。

Sleep 100 にしてありますが、もう少し遅くしても実害はないかもしれません。1000で1秒になります。

改めて、コード全体を掲示します。

'-------------------------------------------
'Option Explicit
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Sub MultiFilesPrintOutR()
　　Dim fNames As Variant
　　Dim fN As Variant
　　Dim sh As Worksheet
　　Const blPRV As Boolean = True 'プレビュー

　　fNames = _
　　Application.GetOpenFilename(FileFilter:="エクセルファイル(*.xls),*.xls" & _
　　",CSVファイル(*.csv),*.csv", _
　　Title:="印刷するファイルを選択", _
　　MultiSelect:=True)
　　If VarType(fNames) = vbBoolean Or IsEmpty(fNames) Then Exit Sub

　　If IsArray(fNames) Then
　　　　If UBound(fNames) > 10 Then
　　　　　　If MsgBox("選択したファイルは、10を越えていますが実行しますか？", vbInformation + vbOKCancel) = vbCancel Then
　　　　　　　　Exit Sub
　　　　　　Else
　　　　　　　　Application.Dialogs(xlDialogPrinterSetup).Show
　　　　　　End If
　　　　End If
　　End If
　　On Error GoTo ErrHandler
　　For Each fN In fNames
　　　　If fN <> ThisWorkbook.FullName Then
　　　　　　With Workbooks.Open(fN)
　　　　　　　　If .ProtectStructure = False Then
　　　　　　　　　　For Each sh In .Worksheets
　　　　　　　　　　　　sh.PrintOut , Preview:=blPRV
　　　　　　　　　　　　Sleep 100
　　　　　　　　　　　　DoEvents '割り込み可能にする
　　　　　　　　　　Next sh
　　　　　　　　　　.Close False '保存を要求せずに閉じる
　　　　　　　　End If
　　　　　　End With
　　　　End If
Jump:
　　Next
　　Exit Sub
ErrHandler:
　 'パスワードなどで開けない場合
　　MsgBox Mid$(fN, InStrRev(fN, "\") + 1) & vbCrLf & Err.Description
　　GoTo Jump
End Sub

'-------------------------------------------

お礼

返信おそくなりましてすみません。
実行し確認させていただいたところ、すばらしい！の一言でした！
Escでキャンセルや、パスワードなどで開けない場合など、追加コードまで提示していただき大変感謝しております。
　まだまだ勉強不足です＞＜　精進します！
本当にありがとうございました！

回答No.7

Wendy02

こんにちは。

ご希望のものと合うかは分かりませんが、ファイル10個の制限をなくしてみました。

'-------------------------------------------

'Option Explicit
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Sub MultiFilesPrintOutR2()
　　Dim fNames As Variant
　　Dim fN As Variant
　　Dim sh As Worksheet
　　Dim pdfFlg As Boolean
　　Dim acPrinter As String

　　Const blPRV As Boolean = False 'プレビュー

　　acPrinter = Application.ActivePrinter
　　Application.Dialogs(xlDialogPrinterSetup).Show
　　If InStr(1, Application.ActivePrinter, "pdf", 1) > 0 Then
　　　　pdfFlg = True
　　End If

　　fNames = _
　　Application.GetOpenFilename(FileFilter:="エクセルファイル(*.xls),*.xls" & _
　　",CSVファイル(*.csv),*.csv", _
　　Title:="印刷するファイルを選択", _
　　MultiSelect:=True)
　　If VarType(fNames) = vbBoolean Or IsEmpty(fNames) Then Exit Sub
　　If Not IsArray(fNames) Then
　　　 fNames = Array(fNames)
　　End If
　　On Error GoTo ErrHandler
　　For Each fN In fNames
　　　　If fN <> ThisWorkbook.FullName Then
　　　　　　With Workbooks.Open(fN)
　　　　　　　　If .ProtectStructure = False Then
　　　　　　　　　　If pdfFlg = False Then
　　　　　　　　　　　　For Each sh In .Worksheets
　　　　　　　　　　　　　　sh.PrintOut , Preview:=blPRV
　　　　　　　　　　　　　　Sleep 100
　　　　　　　　　　　　　　DoEvents '割り込み可能にする
　　　　　　　　　　　　Next sh
　　　　　　　　　　 Else
　　　　　　　　　　　　.Worksheets.PrintOut , Preview:=blPRV
　　　　　　　　　　 End If
　　　　　　　　　　.Close False '保存を要求せずに閉じる
　　　　　　　　End If
　　　　　　End With
　　　　End If
Jump:
　　Next
　　Application.ActivePrinter = acPrinter
　　Exit Sub
ErrHandler:
　 'パスワードなどで開けない場合
　　MsgBox Mid$(fN, InStrRev(fN, "\") + 1) & vbCrLf & Err.Description
　　GoTo Jump
End Sub

お礼

おはようございます。
コードを再考していただき大変感謝しております。
PDF印刷、無事に出来ました＾＾

いろいろな希望はまだあるのですが、きりが無いのと、回答者様のみに負担をかけているので、今回提示されたコードを参考にさせていただき自分なりにやってみます。

長い間大変ご面倒だったとは思いますが、ここまでご助力していただき大変感謝しております。ありがとうございました。

回答No.6

Wendy02

こんばんは。

1. ですが、
>　For Each sh In .Worksheets
>　　　sh.PrintOut , Preview:=blPRV
>　　　Sleep 100
>　　　DoEvents '割り込み可能にする
>　Next sh

現行の設定では、それぞれファイルとしては別になってしまうか、ファイル名を決めてしまうと上書きもあるのかとは思います。PDFの統合ツールもあるようですが、これに関しては、コード側でも直せます。しかし、2と合わせて、コードを分岐させるコードを作らなくてはなりません。どちらかというと、コードを分岐せずに、別途、PDF出力としても良いように思います。どちらでも良いと思います。

2.は、それに付随したことですね。

Docuworks は、使ったことがありませんので分かりませんが、PDF クリエータは何をお使いですか？
いわゆるバーチャル・プリンタとして使用するわけですね。

もし、確認画面だけなら、

FinePrint5
http://www.vector.co.jp/soft/win95/writing/se322363.html

なんでもエコ印刷
http://www.silverstar.co.jp/02products/neco/neco.html

両方とも、体験版があります。

また、バーチャルプリンタ・ドライバというものも、Vector で出いるかと思います。FinePrint5 でしたら、こちらでも、試すことは可能です。PDFでも、今は試してみていませんが、一枚に入れることは可能です。

コードは、一旦、書き直しになるかと思います。

お礼

回答ありがとうございます。
教えていただいた確認用ソフトも使ってみました。確認用に使用する分には十分ですね。情報ありがとうございます。
今回打ち出したファイルを確認用としてみるだけの場合と、そのドキュやPDFを成果品として提出する場合がありまして、確認用だけならば先ほど教えていただいたソフトなどで十分なのですが、PDFなどを提出しなければならないので困っておりました。
なので大変失礼かと思いましたが、紙に打ち出す場合はWendy02様のコードを。PDFなどに打ち出さなければならない場合は＃１様のコードを使用し使い分けておりました。（それでもシート内の解像度の違いなので順番がバラバラになるので後は手作業でやっておりました。）
使用しているソフトは「Adobe PDF」です。読み込むソフトは「Adobe Acrobat 8.0 Standard」は使用しておりました。それ以外に何か必要な情報があれば開示いたしますのでおっしゃってください。
ご多忙の中、ご迷惑をおかけして申し訳ありません。よろしくお願いいたします。

回答No.5

Wendy02

こんばんは。

今回は、勉強させていただきました。コードとしては簡単ですから、問題の発生する部分は潰したつもりです。しばらく、ここを締めずに、コードを使ってみてください。不具合がありましたら、「お礼」側に書けば、メールで届きますから、連絡用にお使いください。

お礼

すみません。「お礼」欄に書いてほしいと言っているのに「補足」欄に書いてしまい、メールが行かなかったでしょうか？改めて書かせていただきます。
補足欄の「２」ですが、前の回答で、必要な場合のみプリンタの設定画面を出せばよいのでは？とありましたが、設定を間違えてA3をA4用紙で出してしまったりなどがあり数箇所打ち出し直したい。などが多々あるため、改めてお聞きしたかったので書かせていただきました。
ご面倒だとは思いますがよろしくお願いします。

補足

おはようございます。お久しぶりです。
Wendy02様に作っていただいたコードをしばらく使わせていただきました。大変感謝しております。
このコードは＃１様のコードとは異なり、開いたブックのシートを全選択ではなく、１シート毎に印刷をかけているのだと思われますが、そこで何点か希望がありまして補足させていただきます。

１、紙を打ち出すプリンタに印刷する場合は問題が無いが、PDFやDocuworksに出力する場合、ひとつのブックなのに１シート毎印刷なのでファイル名が「AAA」「AAA-2」「AAA-3」と異なる文書として印刷されてしまう。PDFにいたっては全て上書きになってしまう。
２、10個以上ファイルを選択しないとプリンタ設定に行かないのを1個でも出るようにするにはどの辺りを変更すればいけるでしょうか？

PDFやDocuworksをPCに入れてないからわからない。PDFなどの為に作ってない。と言われればそれで終わりなのですが、私の場合紙に印刷をかける前に紙の無駄省くためにまずPDFやDocuworksに出力し確認してから打ち出しをかける方法をとっているために困っております。コード内でココを直せばおそらく出来る。などでも構いませんので、御助力頂き思い連絡させていただきました。

回答No.3

Wendy02

こんにちは。

>＞選択したファイルは、10を越えていますが実行しますか？
>のメッセージボックスが出ますがメッセージボックスが出ていてOKボタンを押す前に印刷を始めて>しまうのですが、その選択を待ってから印刷するようにするにはどうしたら宜しいでしょうか？

それには、気づいていました。コードの中で、

'ここは問題があります。
　　　　Application.Dialogs(xlDialogPrint).Show

と書いてあるとおりです。

当面の対処法ですが、このようにしてみたらどうでしょうか。
順序を変えました。お時間があれば、他の方法も試してみてください。私自身、今まで、いろいろ試行錯誤しています。

'-------------------------------------------

　　If IsArray(fNames) Then
'ここは問題があります。
　　　　If UBound(fNames) > 10 Then
　　　　　　If MsgBox("選択したファイルは、10を越えていますが実行しますか？", vbInformation + vbOKCancel) = vbCancel Then
　　　　　　　　Exit Sub
　　　　　　Else
　　　　　　　　Application.Dialogs(xlDialogPrint).Show
　　　　　　End If
　　　　End If
　　End If

'-------------------------------------------
'-------------------------------------------
プリンタを確認する方法は、本来は、ActivePrinterメソッドを使って、このような方法があります。

"\\FMV-DESKPOWER\EPSON PM-4000PX on USB002" の on の後の部分が、固定なら、自動で切り替えることが可能です。ただ、動いてしまうことが多いので、ループで、探したりしますが、コードが複雑になります。

'-------------------------------------------
　　DefPrt = "\\FMV-DESKPOWER\EPSON PM-4000PX on USB002" '規定のプリンタ

　　ActPrt = Application.ActivePrinter '現在のプリンタ

　　If InStr(1, DefPrt, ActPrt, vbTextCompare) > 0 Then
　　　　 MsgBox "設定はそのままで、使えます。", vbInformation
　　Else
　　　　 If MsgBox("プリンタの設定を換えますか？", vbInformation + vbOKCancel) = vbCancel Then
　　　　　　Exit Sub
　　　　 Else
　　　　　　Application.Dialogs(xlDialogPrint).Show

　　　　　　''Application.ActivePrinter = DefPrt　'自動切換え
　　　　 End If
　　End If
'-------------------------------------------

補足

こんにちは。再度回答ありがとうございます。
こんな無知な私の為に試行錯誤して頂き、大変ありがとうございます。
回答者様の書いた通り、順番を変えたコードを今までのコードと差し替えをしたところ、印刷とvbOKCancelのメッセージボックスがカブることはなくなりました。ありがとうございます。
　ただマクロが入っているエクセルbookは、やはり印刷されてしまいます。
選択したbookを開く前に
Application.Dialogs(xlDialogPrint).Show　
↑の実行で印刷されるので、印刷設定画面が出るのをもう少し後の方にし順番を変更するとか、
10個以上選択した場合、実行しますか？というコードに、OKと答えると印刷設定画面が出るのを、どこか他のコードとのセットにしてみる。
など、試行錯誤しているのですが、どうも明後日な方向に向かっているような感じです。。。
やはり回答者様が完璧にコードを作っておりますので、いろいろ変更するとエラーが出てうまくいかないですね。悩みどころです。

回答No.2

Wendy02

こんにちは。

2バイトプロシージャ名やハンガリアン表記は、あまり書かないほうがよいかもしれません。流行はあったとは思いますが、過去形です。解説も必要以上は書く必要はありません。

Const blPRV As Boolean = True 'プレビュー

ここの部分をFalse にすれば、そのまま印刷されます。

>2.現在は通常使うプリンタで印刷するようにしていますが、複数選択し開いた時に始めの1回だけプリンタの設定画面になるようにしたい。

*ここは、少し問題があるようです。

「通常使うプリンタ」というのは、期待していないプリンタが選択されているときだけ出せばよいのではないかと思います。

'-------------------------------------------

Sub MultiFilesPrintOut()
　　Dim fNames As Variant
　　Dim fN As Variant
　　Dim sh As Worksheet
　　Const blPRV As Boolean = True 'プレビュー

　　fNames = _
　　Application.GetOpenFilename(FileFilter:="エクセルファイル(*.xls),*.xls" & _
　　",CSVファイル(*.csv),*.csv", _
　　Title:="印刷するファイルを選択", _
　　MultiSelect:=True)
　　If VarType(fNames) = vbBoolean Or IsEmpty(fNames) Then Exit Sub
　　If IsArray(fNames) Then
'ここは問題があります。
　　　　Application.Dialogs(xlDialogPrint).Show
　　　　If UBound(fNames) > 10 Then
　　　　　　If MsgBox("選択したファイルは、10を越えていますが実行しますか？", vbInformation + vbOKCancel) = vbCancel Then
　　　　　　　　Exit Sub
　　　　　　End If
　　　　End If
　　End If

　　For Each fN In fNames
　　　　On Error GoTo ErrHandler
　　　　If fN <> ThisWorkbook.FullName Then
　　　　　　With Workbooks.Open(fN)
　　　　　　For Each sh In .Worksheets
　　　　　　　　sh.PrintOut , Preview:=blPRV
　　　　　　Next sh
　　　　　　　.Close False '保存を要求せずに閉じる
　　　　　　End With
　　　　End If
Jump:
　　Next
　　Exit Sub

ErrHandler:
　　MsgBox Err.Description
　　GoTo Jump
End Sub

'-------------------------------------------

お礼

すみません～初めに書いてありましたね＞＜　
>Const blPRV As Boolean = True 'プレビュー
ここの部分をFalse にすれば、そのまま印刷されます。
と。。。
やってみたらできました＾＾

それとマクロが入っているbookが印刷されるのと、10個以上選択すると、
＞選択したファイルは、10を越えていますが実行しますか？
のメッセージボックスが出ますがメッセージボックスが出ていてOKボタンを押す前に印刷を始めてしまうのですが、その選択を待ってから印刷するようにするにはどうしたら宜しいでしょうか？

お礼欄ですが、続けて補足させていただきます。

補足

こんにちは。回答ありがとうございます。
　２バイトプロシージャ名はエラーの原因になる。ハンガリアン表記は、使い勝手が悪い…など調べて分かりました。もっと勉強し以後気を付けていきます。ご指摘ありがとうございます。　
　提示していただいたコードを実行してみたのですが、何故かうまくいきませんでした(>_<)何かこちらで変更する箇所などあるのでしょうか？ここは問題がある。と書かれていた所が何かの原因なのでしょうか？
なにせ、自分の実力はマクロの記録をし、足りない必要な部分をサンプルコードなどを引用し追加していく程度しか出来ないので、提示していただいたコードを完璧に理解は出来ないレベルです。なので説明などもわからなくなるので消してなかったです…質問の時は皆さんご存じなので、簡潔に表記するため消すようにします。
　それで実行してみたマクロですが、印刷されるのは、マクロコードが入っているエクセルで、選択したブックは印刷プレビューまでしか出ないんです。出来れば、選択しプリンタ設定、後は全て自動でやってくれる。というのが理想なんです。10個以上選択すると、メッセージボックスが出て、実行するかしないかを聞かれるというのは、作って頂いて大変感謝しております。
　以後このマクロを使い続けて行きたいので、大変ご面倒だとは思いますが、よろしくお願いいたします。

回答No.1

kybo

こまかいエラーチェックはしていませんが、下記のような感じで出来ます。

Sub 複数のファイルを選択して開く_エクセル版()
'複数のファイルを選択する例
Dim vntFileName As Variant
Dim vntGetFileName As Variant
Dim B As Boolean
Dim W As Workbook
'ファイルを開くダイアログを開きます
vntFileName = _
Application.GetOpenFilename( _
FileFilter:="エクセルファイル(*.xls),*.xls" & _
",CSVファイル(*.csv),*.csv" _
, FilterIndex:=1 _
, Title:="印刷するファイルを選択" _
, MultiSelect:=True _
)
'ファイルが選択されているとき(vntFileNameが配列型)は
'選択した全てのファイルをWorkbooks.Openメソッドを使い開きます。
If IsArray(vntFileName) Then

For Each vntGetFileName In vntFileName
Set W = Workbooks.Open(vntGetFileName)
If B Then
'すべてのシートを印刷
W.Worksheets.PrintOut Copies:=1 '通常設定のプリンタで出力
Else
W.Worksheets.Select
'印刷ダイアログを表示
Application.Dialogs(xlDialogPrint).Show
B = True
End If
W.Close False
Next
End If
End Sub

お礼

おはようございます。返信遅れましてすみません。
実行させていただいたところ問題なく動作し、思い描いたようなマクロでした。助かりました！ありがとうございました。