TKSoft-Online

 
 
Public Sub ChangePrinter(sObjName As String, iPrtIndex As Integer, _
                         Optional lngCopies As Long = 1, Optional lngAusrichtung As Long = 1, _
                         Optional iTyp = 0)
'---------------------------------------------------------------------------------------
' Procedure : ChangePrinter
' DateTime  : 05.08.2005 15:36
' Author    : TommyK
' Purpose   : wechselt den Standarddrucker für den gewählten Bericht
' Inputs    : sObjName = Name des Berichts/Forms, iPrtIndex = Index des gewählten Druckers
'             lngCopies = Anzahl der Kopien, lngAusrichtung = 1 = Hochformat, 2 = Querformat
'             iTyp 0 = Bericht, 1 = Formular
' Output    :
' Example   : ChangePrinter \"rpt_MeinBericht\", 1
'             Würde den Bericht \"rpt_MeinBericht\" auf dem 2. Drucker des Systems
'             mit 1 Kopie und im Hochformat ausgeben
'---------------------------------------------------------------------------------------
    Dim prtDefault As Printer
    Dim prtObjPrinter As Printer
    Dim prtPrinter As Printer
 
    On Error GoTo ChangePrinter_Error
 
    Set prtDefault = Application.Printer
    Set prtPrinter = Application.Printers(iPrtIndex)
    Application.Printer = prtPrinter
    If iTyp = 0 Then
        DoCmd.OpenReport sObjName, acViewDesign, acHidden
        Set prtObjPrinter = Reports(sObjName).Printer
        With Reports(sObjName).Printer
            .Copies = lngCopies
            .Orientation = lngAusrichtung
        End With
        DoCmd.OpenReport sObjName, acViewNormal
        DoCmd.Close acReport, sObjName, acSaveNo
    Else
        DoCmd.OpenForm sObjName, acDesign, , , , acHidden
        Set prtObjPrinter = Forms(sObjName).Printer
        With Forms(sObjName).Printer
            .Copies = lngCopies
            .Orientation = lngAusrichtung
        End With
        DoCmd.OpenForm sObjName, acNormal
        DoCmd.PrintOut acPrintAll, , , acHigh, lngCopies
        DoCmd.Close acForm, sObjName, acSaveNo
    End If
 
    Set prtObjPrinter = Nothing
    Application.Printer = prtDefault
 
    On Error GoTo 0
    Exit Sub
 
ChangePrinter_Error:
    Dim strErrString As String
    strErrString = \"Error Information...\" & vbCrLf
    strErrString = strErrString & \"Error#: \" & Err.Number & vbCrLf
    strErrString = strErrString & \"Description: \" & Err.Description
    MsgBox strErrString, vbCritical + vbOKOnly, \"Error in procedure ChangePrinter of Modul mod_Printers\"
End Sub