• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• This function will print any ADO recordset to the printer. Just pass the ADO recordset and a title

This function will print any ADO recordset to the printer. Just pass the ADO recordset and a title

This function will print any ADO recordset to the printer. Just pass the ADO recordset and a title to the function and it takes care of the

Rate This function will print any ADO recordset to the printer. Just pass the ADO recordset and a title

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

    
    On Error GoTo ErrorHandler
    
       
    Me.MousePointer = vbHourglass
    
    Dim i As Integer
    Dim iTab As Integer
    
    'Move the cursor to the first record.
    If Not rsPrint.BOF Then
        rsPrint.MoveFirst
    End If
    
    'Print report title.
    Printer.Print
    Printer.Print
    Printer.FontSize = 14
    Printer.FontBold = True
    Printer.Print sReportTitle
    Printer.FontBold = False
    Printer.FontSize = 10
    Printer.Print
    Printer.Print
    Printer.Print
    
    'Print column headings for the first page.
    iTab = 20
    Printer.FontUnderline = True
    For i = 0 To rsPrint.Fields.Count - 1
        Printer.Print rsPrint.Fields(i).Name; Tab(iTab);
        iTab = iTab + 20
    Next i
    Printer.Print
    Printer.Print
    Printer.FontUnderline = False
    
    Do While Not rsPrint.EOF
        
        'Start a new page when end of page is reached.
        If Printer.CurrentY + Printer.TextHeight(rsPrint(rsPrint.Fields(0).Name)) > _
            Printer.ScaleHeight - 600 Then
            
            'Start a new page.
            Printer.NewPage

            'Print column headings for the remaining page.
            Printer.Print
            Printer.Print
            iTab = 20
            Printer.FontUnderline = True
            For i = 0 To rsPrint.Fields.Count - 1
                Printer.Print rsPrint.Fields(i).Name; Tab(iTab);
                iTab = iTab + 20
            Next i
            Printer.Print
            Printer.Print
            Printer.FontUnderline = False
        End If
        
        'Print a record of the recordset.
        iTab = 20
        For i = 0 To rsPrint.Fields.Count - 1
            Printer.Print rsPrint.Fields(i).Value; Tab(iTab);
            iTab = iTab + 20
        Next i
        Printer.Print
        
        'Move to the next record.
        rsPrint.MoveNext
    Loop
    
    'Send data to the printer.
    Printer.EndDoc
    
    'Move the cursor to the first record.
    If Not rsPrint.BOF Then
        rsPrint.MoveFirst
    End If


ErrorHandler:
    Select Case Err.Number
        Case 0
            'Everything was OK.
            Me.MousePointer = vbDefault
            Exit Sub
        Case Else
            'Unknown error occured.
            Me.MousePointer = vbDefault
            MsgBox ("An unexpected error has occured." & vbCrLf & _
                    "Source: " & Me.Name & vbCrLf & _
                    "Error Number: " & Err.Number & vbCrLf & _
                    "Error Message: " & Err.Description), _
                    vbCritical, App.Title & " - Runtime Error"
            Exit Sub
    End Select

End Sub