#1
  1. No Profile Picture
    Contributing User
    Devshed Newbie (0 - 499 posts)

    Join Date
    Oct 2010
    Posts
    104
    Rep Power
    5

    Ask code set printer for the report ?


    Assuming the computer has installed 2 printer name: printer1, printer2 and in my program has 4 report name: ActiveReport1, ... ActiveReport4. Status to avoid crafted before viewing or printing in the printer before you have to choose, I can write code automatically select the printer before printing or print view, for example, when prints ActiveReport odd numbers will viewed or print on printer1 and ActiveReport even numbers when viewed in print or on printer2. for example code this.
  2. #2
  3. No Profile Picture
    Contributing User
    Devshed Newbie (0 - 499 posts)

    Join Date
    Aug 2011
    Posts
    289
    Rep Power
    45
    There are 2 ways of utilizing your available printers. For occasional use, the Common Dialog control works best. For production programs where you do not want to waste time selecting the printer, you can programatically direct output to an established printer driver.

    To list the available printers:
    Code:
    Private Sub ListPrinters()
        Dim PrtPointer As Integer
        Dim PrtObj As Printer
        For Each PrtObj In Printers
            PrtList.AddItem PrtObj.DeviceName
        Next
        For PrtPointer = 0 To PrtList.ListCount - 1
            If PrtList.List(PrtPointer) = Printer.DeviceName Then Exit For
        Next PrtPointer
        PrtList.Width = 2295
        PrtList.Height = 2400
        PrtList.ListIndex = PrtPointer
        PrtList.Visible = True
        PrtList.SetFocus
    End Sub
    The following routine lists the properties of the selected printer, assigns it to a variable, and stores it in the registry.
    Code:
    Sub GetPrinterInfo(PrtSelected As Long)
        Dim Msg$, Response$, M%, N%, Runfile%
        Set Printer = Printers(PrtSelected)
        Msg$ = "Name -       " + Printer.DeviceName + vbCrLf
        Msg$ = Msg$ + "Port -       " + Printer.Port + vbCrLf
        Msg$ = Msg$ + "Driver -     " + Printer.DriverName + vbCrLf
        Msg$ = Msg$ + "Orientation -" + Str$(Printer.Orientation) + vbCrLf
        Msg$ = Msg$ + "PaperSize -  " + Str$(Printer.PaperSize) + vbCrLf
        Msg$ = Msg$ + "Height -     " + Str$(Printer.Height) + vbCrLf
        Msg$ = Msg$ + "Width -      " + Str$(Printer.Width) + vbCrLf
        Msg$ = Msg$ + "Font -       " + Printer.Font + vbCrLf
        Msg$ = Msg$ + "PointSize -   " + Str$(Printer.Font.Size) + vbCrLf
        Msg$ = Msg$ + "ScaleMode -  " + Str$(Printer.ScaleMode) + vbCrLf
        Msg$ = Msg$ + "ScaleLeft -  " + Str$(Printer.ScaleLeft) + vbCrLf
        Msg$ = Msg$ + "ScaleTop -   " + Str$(Printer.ScaleTop) + vbCrLf
        Msg$ = Msg$ + "Twips/PxlX - " + Str$(Printer.TwipsPerPixelX) + vbCrLf
        Msg$ = Msg$ + "Twips/PxlY - " + Str$(Printer.TwipsPerPixelY) + vbCrLf
        Msg$ = Msg$ + "TrackDefault-" + Str$(Printer.TrackDefault) + vbCrLf + vbCrLf
        MsgBox Msg$
        Response$ = GetPrinterAssign
        N% = InStr(Response$, vbCrLf) + 2
        Msg$ = "SELECTED PRINTER = " + Printer.DeviceName + "-->" + Printer.Port + vbCrLf + vbCrLf
        Msg$ = Msg$ + "PRINTER #1" + vbCrLf + PrtDef(1, 0) + "-->" + PrtDef(1, 2) + vbCrLf
        Msg$ = Msg$ + Left$(Response$, N% - 1) + vbCrLf
        M% = N%
        N% = InStr(M%, Response$, vbCrLf) + 2
        Msg$ = Msg$ + "PRINTER #2" + vbCrLf + PrtDef(2, 0) + "-->" + PrtDef(2, 2) + vbCrLf
        Msg$ = Msg$ + Mid$(Response$, M%, N% - M%) + vbCrLf
        M% = N%
        N% = InStr(M%, Response$, vbCrLf) + 2
        Msg$ = Msg$ + "PRINTER #3" + vbCrLf + PrtDef(3, 0) + "-->" + PrtDef(3, 2) + vbCrLf
        Msg$ = Msg$ + Mid$(Response$, M%, N% - M%) + vbCrLf
        Msg$ = Msg$ + "TO ASSIGN PRINTER, ENTER #, or Cancel"
        PrtList.Visible = False
        PrtList.Clear
        Response$ = InputBox(Msg$)
        If Len(Response$) > 0 Then
            Select Case Response$
                Case "1"
                    N% = MsgBox(Printer.DeviceName + " will be assigned as Printer #1!", 1)
                    If N% = 2 Then Exit Sub
                    PrtDef(1, 0) = Printer.DeviceName
                    SaveSetting VBApp, "Settings", "Printer1", Printer.DeviceName
                    PrtDef(1, 2) = Printer.Port
                    SaveSetting VBApp, "Settings", "Port1", Printer.Port
                    PrtDef(1, 1) = Trim$(Str$(PrtSelected))
                Case "2"
                    N% = MsgBox("Printer 2 is generally reserved for Ticket Printer!" + vbCrLf + "Proceed Anyway?", 257)
                    If N% = 2 Then Exit Sub
                    PrtDef(2, 0) = Printer.DeviceName
                    SaveSetting VBApp, "Settings", "Printer2", Printer.DeviceName
                    PrtDef(2, 2) = Printer.Port
                    SaveSetting VBApp, "Settings", "Port2", Printer.Port
                    PrtDef(2, 1) = Trim$(Str$(PrtSelected))
                Case "3"
                    N% = MsgBox(Printer.DeviceName + " will be assigned as Printer #3!", 1)
                    If N% = 2 Then Exit Sub
                    PrtDef(3, 0) = Printer.DeviceName
                    SaveSetting VBApp, "Settings", "Printer3", Printer.DeviceName
                    PrtDef(3, 2) = Printer.Port
                    SaveSetting VBApp, "Settings", "Port3", Printer.Port
                    PrtDef(3, 1) = Trim$(Str$(PrtSelected))
                Case Else
                    Exit Sub
            End Select
        End If
     End Sub
    When your application is loaded, this routine is used to recover the information:
    Code:
    Private Function FindPrinters() As String
        Dim DNum%, N%, M%
        Dim A$, B$, Msg$
        On Error GoTo FindPrintersErr
        'Get application printer info from registry
        For N% = 1 To 3
            PrtDef(N%, 0) = GetSetting(ParentApp, "Settings", Trim("Printer" + Trim(Str(N))), "")
            PrtDef(N%, 2) = GetSetting(ParentApp, "Settings", Trim("Port" + Trim(Str(N))), "")
        Next N%
        'Compare to system Printer Info
        For DNum% = 0 To UBound(PDev$)
            N% = InStr(PDev$(DNum%), Chr$(0))
            If Left$(PDev$(DNum%), N% - 1) = PrtDef(1, 0) Then
                A$ = Mid$(PDev$(DNum%), N% + 1)
                M% = InStr(A$, Chr$(0))
                B$ = Left$(A$, M% - 1)
                If PrtDef(1, 2) = Mid$(A$, M% + 1) Then
                    PrtDef(1, 1) = DNum%
                End If
            End If
            If Left$(PDev$(DNum%), N% - 1) = PrtDef(2, 0) Then
                A$ = Mid$(PDev$(DNum%), N% + 1)
                M% = InStr(A$, Chr$(0))
                B$ = Left$(A$, M% - 1)
                If PrtDef(2, 2) = Mid$(A$, M% + 1) Then
                    PrtDef(2, 1) = DNum%
                End If
            End If
            If Left$(PDev$(DNum%), N% - 1) = PrtDef(3, 0) Then
                A$ = Mid$(PDev$(DNum%), N% + 1)
                M% = InStr(A$, Chr$(0))
                B$ = Left$(A$, M% - 1)
                If PrtDef(3, 2) = Mid$(A$, M% + 1) Then
                    PrtDef(3, 1) = DNum%
                End If
            End If
            If Left$(PDev$(DNum%), N% - 1) = Printer.DeviceName Then
                A$ = Mid$(PDev$(DNum%), N% + 1)
                M% = InStr(A$, Chr$(0))
                B$ = Left$(A$, M% - 1)
                If Mid$(A$, M% + 1) = Printer.Port Then
                    DefPrt$ = DNum%
                End If
            End If
        Next DNum%
        'Prepare error msg if printer not found
        If Len(PrtDef(1, 1)) = 0 Then
            Msg$ = "Printer #1, " + PrtDef(1, 0) + " on " + PrtDef(1, 2) + vbCrLf
        ElseIf Len(PrtDef(2, 1)) = 0 Then
            Msg$ = "Printer #2, " + PrtDef(2, 0) + " on " + PrtDef(2, 2) + vbCrLf
        ElseIf Len(PrtDef(3, 1)) = 0 Then
            Msg$ = "Printer #3, " + PrtDef(3, 0) + " on " + PrtDef(3, 2) + vbCrLf
        End If
        FindPrinters = Msg$
        Exit Function
    FindPrintersErr:
        FindPrinters = "Error" + Str$(Err) + ", " + Error$(Err)
    End Function
    Finally, this is an example of how to use the information:
    Code:
    Private Sub BPrint_Click()
        Dim PStr$, Msg$, Prt%, PrtFlg%, N%
        Dim ErrorCode As Variant
        Dim Temp As Long
        If PCount% > 0 Then Exit Sub    'to protect against double clicks
        If UBound(PArray) < 1 Then
            MsgBox "Already printed!" + vbCrLf + "Select name again for second Print."
            Exit Sub
        End If
        On Error GoTo BPrintErr
        Msg$ = ReadParam()
        MousePointer = 11
        If PrtNum = 1 Then
            Prt% = Val(PrtDef(1, 1))
        ElseIf PrtNum = 2 Then
            Prt% = Val(PrtDef(2, 1))
        ElseIf PrtNum = 3 Then
            Prt% = Val(PrtDef(3, 1))
        Else
            Prt% = -1
        End If
        If Prt% < 0 Then
            MsgBox "Driver not installed!" + vbCrLf + "Routine will not print or update files!", 16
            PrtFlg% = False
            MousePointer = 0
            Exit Sub
        End If
        If Len(VenCopy) = 0 Then VenCopy = NumCopy
        PStr$ = PrtFont + Chr$(0) + FWidth + Chr$(0) + FHeight + Chr$(0) + LMargin + Chr$(0) + TMargin + Chr$(0) + VenCopy
        Msg$ = SetupPrinter(Prt%, PStr$)
        If Len(Msg$) > 0 Then If Asc(Msg$) = 94 Then GoTo BPrintClose1
        txtPrint.Visible = True
        txtPrint.Refresh
        N% = UBound(PArray) - 2
        PArray(N%) = Space$(10) + "Items totalling" + TFare + Right$(TCom, 12) + TAmtDue
        Mid$(PArray(N%), 5) = Str$(NLines)
        For N% = 0 To UBound(PArray)
            Msg$ = PrintLine(PArray(N%)) + Msg$
        Next N%
        ReDim Preserve PArray(11)
        PCount% = 0
        txtPrint.Text = "Print Job Sent"
        txtPrint.Refresh
        If Len(Msg$) = 0 Then
            Printer.EndDoc
        Else
            Call LogError(Msg$)
            Printer.KillDoc
            Printer.EndDoc
            txtPrint.Visible = False
            Msg$ = "Print Routine Failed!"
        End If
    BPrintClose1:
        If Len(Msg$) Then
            MsgBox Msg$ + vbCrLf + "Consult Error Log for details." + vbCrLf + "Files not Updated!", 16, "PRINTER ERROR"
        End If
        Temp = Timer + 1
        Do Until Timer > Temp
            DoEvents
        Loop
        Beep
        txtPrint.Visible = False
        MousePointer = 0
        'PrtFlg% = False
        Exit Sub
    BPrintErr:
        ErrorCode = Err
        Call LogError("^" + Str$(Err) + " Vendor Print")
        Call FatalError(ErrorCode)
        End
    End Sub
    J.A. Coutts

IMN logo majestic logo threadwatch logo seochat tools logo