プリント関連

PrintUtil.bas

''' <summary>
''' 指定されたワークブックの、配列で与えられたシート名を持つワークシートを印刷する
''' 引数チェックを行っていないため要注意
''' プリンター名やシートの存在を確認すること
''' </summary>
''' <param name="objWorkbook">対象のワークブック<param>
''' <param name="strWorksheetNameArray">ワークシート名の配列 (Array("hoge", "fuga", "piyo") ...)<param>
''' <param name="lngCopies">部数<param>
''' <param name="strPrinterName">プリンター名<param>
''' <param name="strPrinterSettingFilePath">プリンターの印刷設定<param>
Private Sub PrintOutWorksheets(ByVal objWorkbook As Workbook, ByRef strWorksheetNameArray As Variant, ByVal lngCopies As Long, ByVal strPrinterName As String, ByVal strPrinterSettingFilePath As String)
    Dim objWshShell As Object: Set objWshShell = CreateObject("WScript.Shell")
    objWshShell.Run "rundll32 printui.dll PrintUIEntry /Sr /n """ & strPrinterName & """ /a """ & ThisWorkbook.Path & "\" & strPrinterSettingFilePath & """ u", 1, True
    Set objWshShell = Nothing
    
    '利用するプリンタ名
    '"DocuCentre-V 4070"
    '"KONICA MINOLTA PS BW Laser Class Driver"
    objWorkbook.Sheets(strWorksheetNameArray).PrintOut _
        Copies:=lngCopies, _
        ActivePrinter:=strPrinterName, _
        Collate:=True
End Sub

''' <summary>
''' Array("1", "2", "3", "4", "5", ...
''' から解放されたい
''' </summary>
Private Function MakeNumStringArray(ByVal lngStart As Long, ByVal lngEnd As Long) As Variant
    Dim arr As Variant
    arr = Array()
    Dim i As Long
    For i = lngStart To lngEnd
        ReDim Preserve arr(UBound(arr) + 1)
        arr(UBound(arr)) = CStr(i)
    Next i
    MakeNumStringArray = arr
End Function

''' <summary>
''' Array(1, 2, 3, 4, 5, ...
''' </summary>
Private Function MakeNumLongArray(ByVal lngStart As Long, ByVal lngEnd As Long) As Variant
    Dim arr As Variant
    arr = Array()
    Dim i As Long
    For i = lngStart To lngEnd
        ReDim Preserve arr(UBound(arr) + 1)
        arr(UBound(arr)) = i
    Next i
    MakeNumLongArray = arr
End Function

''' <summary>
''' ワークブックに含まれる全てのワークシート名の配列
''' </summary>
Private Function MakeSheetsArray(ByVal wb As Workbook) As Variant
    Dim arr As Variant
    arr = Array()
    Dim i As Long
    For i = 1 To wb.Worksheets.Count
        ReDim Preserve arr(UBound(arr) + 1)
        arr(UBound(arr)) = wb.Worksheets(i).Name
    Next i
    MakeSheetsArray = arr
End Function