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

Question

お世話になっております。
タイトル通りのマクロの作成をしているのですが、行き詰ってしまい質問させていただきました。

説明させていただきますと、、
実行し、複数のエクセル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

Wendy02 · Accepted Answer

こんばんは。

>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

'-------------------------------------------

Wendy02 · Answer

こんにちは。

ご希望のものと合うかは分かりませんが、ファイル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

Wendy02 · Answer

こんばんは。

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でも、今は試してみていませんが、一枚に入れることは可能です。

コードは、一旦、書き直しになるかと思います。

Wendy02 · Answer

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

Wendy02 · Answer

こんにちは。

>＞選択したファイルは、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
'-------------------------------------------

Wendy02 · Answer

こんにちは。

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

'-------------------------------------------

kybo · Answer

こまかいエラーチェックはしていませんが、下記のような感じで出来ます。

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

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

こんばんは。

こんにちは。

こんばんは。

こんばんは。

この回答への補足

こんにちは。

この回答への補足

こんにちは。

この回答への補足

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

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング