Declare
VB Code:
Public crApp As New CRAXDRT.Application Public crRep As New CRAXDRT.Report Private rptRc As New Recordset Private rptSubRc As New Recordset Private rptSubRc2 As New Recordset
Module
VB Code:
Public Sub DriverAdvanceHistory(ByVal d As Date) Busy rptRc.Open "SELECT CD.CoachDriverID, CD.Name, CD.Contact, " _ & "CA.CoachDriverAdvanceID, CA.AdvanceDate, CA.Amount AS 'AdvanceAmount', CA.Balance, " _ & "CC.ClearDate, CC.Amount AS 'ClearAmount', A.Name AS 'Account', (CASE CA.AdvanceBy WHEN 0 THEN 'Bank' WHEN 1 THEN 'Cash' END) AS 'By' " _ & "FROM CoachDriver CD, CoachDriverAdvance CA LEFT JOIN CoachDriverClear CC ON CA.CoachDriverAdvanceID = CC.CoachDriverAdvanceID, Account A " _ & "WHERE CD.CoachDriverID = CA.CoachDriverID " _ & "AND AdvanceDate BETWEEN '" & Format(d, "yyyyMMdd") & "' AND GETDATE() " _ & "AND CA.AccountID = A.AccountID " _ & "ORDER BY CD.Name, CA.AdvanceDate, CC.ClearDate", cn, adOpenForwardOnly, adLockReadOnly If rptRc.RecordCount = 0 Then rptRc.Close MsgBox "There is no data in the report.", vbInformation + vbOKOnly Idle Exit Sub End If Set crRep = crApp.OpenReport(App.Path & "\Reports\Advance\DriverAdvanceHistory.rpt") rptSubRc.Open "SELECT CoachDriverID, SUM(ISNULL(Balance, 0)) AS 'BalanceBF' " _ & "FROM CoachDriverAdvance " _ & "WHERE CoachDriverID IN (SELECT CoachDriverID FROM T_CoachDriver) " _ & "AND AdvanceDate NOT BETWEEN '" & Format(d, "yyyyMMdd") & "' AND GETDATE() " _ & " GROUP BY CoachDriverID", cn, adOpenForwardOnly, adLockReadOnly rptSubRc2.Open "SELECT CoachDriverID, SUM(ISNULL(Balance, 0)) AS 'Balance' " _ & "FROM CoachDriverAdvance " _ & "WHERE CoachDriverID IN (SELECT CoachDriverID FROM T_CoachDriver) " _ & "GROUP BY CoachDriverID", cn, adOpenForwardOnly, adLockReadOnly With crRep .ReadRecords .DiscardSavedData .PaperSize = crPaperA4 .PaperOrientation = crPortrait .OpenSubreport("DriverAdvanceBalanceBF").Database.SetDataSource rptSubRc .OpenSubreport("DriverAdvanceBalance").Database.SetDataSource rptSubRc2 .Database.SetDataSource rptRc End With Printer.PaperSize = vbPRPSA4 Printer.Orientation = vbPRORPortrait frmPrint.txtDescription = "Driver Advance History" & vbCrLf _ & "From " & Format(d, "dd MMMM yyyy") frmPrint.Show vbModal rptRc.Close rptSubRc.Close rptSubRc2.Close Set crRep = Nothing End Sub
frmPrint
VB Code:
Option Explicit Private ptr As Printer Private Sub SetPrinter() Dim p As Printer Set ptr = Printer ' Made default For Each p In Printers If lvwPrinter.SelectedItem = p.DeviceName Then Set ptr = p Exit For End If Next Set p = Nothing crRep.SelectPrinter ptr.DriverName, ptr.DeviceName, ptr.Port crRep.PaperOrientation = Printer.Orientation End Sub Private Sub RefreshPrinter() With lvwPrinter.ListItems For Each ptr In Printers .Add , , ptr.DeviceName, 1 Next Dim i As Integer For i = 1 To .Count If .Item(i) = Printer.DeviceName Then .Item(i).Selected = True Exit For End If Next End With End Sub Private Sub cmdCancel_Click() Unload Me End Sub Private Sub cmdPreview_Click() Busy SetPrinter Load frmPreview DoEvents frmPreview.Show vbModal DoEvents Idle End Sub Private Sub cmdPrint_Click() Busy SetPrinter DoEvents crRep.PrintOut False DoEvents Idle End Sub Private Sub Form_Activate() Idle End Sub Private Sub Form_Load() RefreshPrinter Idle End Sub
frmPrint
VB Code:
Option Explicit Private Sub Form_Load() Busy On Error Resume Next crvPreview.ReportSource = crRep DoEvents crvPreview.ViewReport crvPreview.Refresh Idle End Sub Private Sub Form_Resize() crvPreview.Top = 0 crvPreview.Left = 0 crvPreview.Height = ScaleHeight crvPreview.Width = ScaleWidth End Sub Private Sub Form_Unload(Cancel As Integer) Set frmPreview = Nothing End Sub
Hi I'm having appcation error, the memory xxxx to xxx canot be "read" or "write" error while using these kind of module.
The first print is Ok, but following report will be cause the error.
However I've tried many ways:
1) Put declare of all declaration inside the sub
2) Directly output to frmpreview without going into frmPrint
3) Print directly without going into frmPrint
4) set crrep = nothing after use (cause hangs directly)
5) etc
The cr I'm using it's 9.0 sp6, vb6.0 sp6, ado 2.8. I wonder any solution for my problem? Quite urgent for this, cause the program is done and I only have this major printing problem.
Thank you very much~
