52本目：複数シートの一括印刷

出題：複数シートの一括印刷

#VBA100本ノック 52本目
シート名に「印刷」という文字を含むシートを全て印刷したい。
ただし途中で他の人の印刷が紛れ込まないように、印刷キューには1ジョブで登録したい。
VBAは確認のためプレビューで記述、つまり、1回のプレビューで複数シートを出力してください。
※ブックは任意

◇ 出題ページはこちら

ソースコード

Option Explicit

' 100本ノック052：複数シートの一括印刷
Sub シート名に印刷を含むシートを一括印刷する()
    
    Dim wb対象ブック As Workbook: Set wb対象ブック = ThisWorkbook
    
    ' 対象のシートを配列に格納
    Dim Arr対象シートリスト() As String
    Dim count対象シート As Long
    Dim シート As Worksheet
    For Each シート In wb対象ブック.Worksheets
    
        If InStr(シート.Name, "印刷") > 0 Then
            count対象シート = count対象シート + 1
            ReDim Preserve Arr対象シートリスト(1 To count対象シート)
            Arr対象シートリスト(count対象シート) = シート.Name
        End If
        
    Next
    
    If count対象シート = 0 Then Exit Sub
    
    ' 印刷プレビューを開く
    wb対象ブック.Worksheets(Arr対象シートリスト).PrintPreview
    
End Sub

解説

Worksheetsプロパティの引数に文字列配列(Array)を渡すと、
各要素をシート名としてそのシート群を取得することが出来ます。

CopyやDeleteを一括ででき、今回のように印刷もできます。

コレクションであれば見つけるたびにAddするだけで済むのですが、
Arrayである必要があるため、面倒ですがReDim Preserveを使用して下さい。

なお、今回のようにPrintPreviewメソッドを使用しても、
Printメソッドの引数PreviewにTrueを渡しても、
いずれも以下の印刷プレビューが開いてしまいます。

いつもの印刷プレビューを開くには、
対象シートをSelectで複数選択したうえで、
SendKeyメソッドでCtrl+Pを送信してください。

Sub シート名に印刷を含むシートを一括印刷する_いつものプレビュー版()
    
    Dim wb対象ブック As Workbook: Set wb対象ブック = ThisWorkbook
    
    ' 対象のシートを順次選択
    Dim count対象シート As Long
    Dim シート As Worksheet
    For Each シート In wb対象ブック.Worksheets
    
        If InStr(シート.Name, "印刷") > 0 Then
            count対象シート = count対象シート + 1
            シート.Select Replace:=(count対象シート = 1)
        End If
        
    Next
    
    If count対象シート = 0 Then Exit Sub
    
    ' 印刷プレビューを開く
    wshSendKeys "^p"
    
End Sub

' WshShellのSendKeys
Public Sub wshSendKeys(Keys As String, Optional Wait As Boolean = False)
    Static wshShell As Object
    If wshShell Is Nothing Then Set wshShell = CreateObject("WScript.Shell")
    Call wshShell.SendKeys(Keys, Wait)
End Sub

Application.SendKeysを使っても良いのですが、
NumLockがなぜか起動してしまうバグがあるため、
WSHオブジェクトの方のSendKeysを使っています。

SendKeysは安定性に欠きますので、
どうしてもという場面でだけ使用していきましょう。