Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations biv343 on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

preview mode, totals fine; print mode, 1st page totals are 2nd pages'

Status
Not open for further replies.

nipmyst

Programmer
Mar 9, 2003
2
US
Hello,

when I preview my report, all calculations on all pages are correct for the current rep name shown. However, when I click on the print button, the second page calcs now appear for the first rep name, and the second rep's calcs appear on each remaining page (there are 14 reps in all). the client's data base consists of 6 tables; the two largest (500,000 + records) being where the bulk of the data comes from. The relationships are not direct between the tables so I had to create an additional link table to get the correct data. I use several queries in the report and receive no errors while processing. It's just when I print that the report is not correct. As stated above, ; preview mode is fine. Any thoughts?

below is a sample of the vba code used. I use a form to get the report date range and call the report from it. I eliminated some of the calcs as they're the same as for the remaining code, just outside of the date range selected.

Option Compare Database
Option Explicit
Dim mstrRepName As String

Private Sub Report_Activate()
Call Report_Page
End Sub

Private Sub Report_NoData(Cancel As Integer)
MsgBox "No data for the data range entered ... closing report"
Cancel = True
End Sub

Private Sub Report_Page()
On Error GoTo HandleErr

mstrRepName = Me!txtRepName
Call Get_RepData
Call Process_Rep_Data

ExitHere:
If Err.Number = 0 Then
Exit Sub
End If

HandleErr:
' display a message with the error number and description
MsgBox "Error Num: " & Err.Number & " Desc: " & Err.Description

Resume ExitHere

End Sub

Sub GetRep_Data()
Dim strSQL As String

On Error GoTo HandleDataErr

' delete data from tables
strSQL = "Delete * FROM tblUniverseRep;"
CurrentDb.Execute strSQL
strSQL = "Delete * FROM tblBldgRep;"
CurrentDb.Execute strSQL
strSQL = "Delete * FROM tblNonContactedRep;"
CurrentDb.Execute strSQL

strSQL = "INSERT INTO tblUniverseRep " _
& "SELECT tblCurrentTMReps.rep_name, informix_tm_contact.contact_date, " _
& "[50_bldg_sdl_qry_tbl_univ].pin, [50_bldg_sdl_qry_tbl_univ].mail_date, " _
& "informix_orders.order_date, informix_orders.demand_revenue, informix_orders_offers.offer_no " _
& "FROM (tblCurrentTMReps LEFT JOIN ((50_bldg_sdl_qry_tbl_univ RIGHT JOIN informix_tm_contact " _
& "ON [50_bldg_sdl_qry_tbl_univ].pin = informix_tm_contact.pin) LEFT JOIN (informix_names " _
& "LEFT JOIN informix_orders ON informix_names.account_no = informix_orders.account_no) " _
& "ON informix_tm_contact.pin = informix_names.pin) " _
& "ON tblCurrentTMReps.rep_name = informix_tm_contact.rep_name) " _
& "LEFT JOIN informix_orders_offers ON informix_orders.order_no = informix_orders_offers.order_no " _
& "WHERE ((tblCurrentTMReps.rep_name)= '" & mstrRepName & "'); "
CurrentDb.Execute strSQL

strSQL = "INSERT INTO tblBldgRep " _
& "SELECT tblCurrentTMReps.rep_name, informix_building.pin, " _
& "informix_tm_contact.contact_date, " _
& "informix_tm_contact.contact_expire_dt, informix_orders.order_date, " _
& "informix_orders.demand_revenue " _
& "FROM informix_building RIGHT JOIN ((tblCurrentTMReps LEFT JOIN (informix_tm_contact " _
& "LEFT JOIN (informix_names LEFT JOIN informix_orders ON informix_names.account_no = informix_orders.account_no) " _
& "ON informix_tm_contact.pin = informix_names.pin) ON tblCurrentTMReps.rep_name = informix_tm_contact.rep_name) " _
& "LEFT JOIN informix_orders_offers ON informix_orders.order_no = informix_orders_offers.order_no) " _
& "ON informix_building.pin = informix_tm_contact.pin " _
& "WHERE ((tblCurrentTMReps.rep_name)= '" & mstrRepName & "');"
CurrentDb.Execute strSQL

strSQL = "INSERT INTO tblNonContactedRep " _
& "SELECT tblBldgRep.rep_name, tblBldgRep.pin, " _
& "tblBldgRep.contact_date, tblBldgRep.contact_expire_dt, tblBldgRep.order_date, " _
& "tblBldgRep.demand_revenue, tblBldgRep.offer_no " _
& "FROM tblBldgRep LEFT JOIN tblUniverseRep " _
& "ON tblBldgRep.pin = tblUniverseRep.pin WHERE (((tblUniverseRep.pin) Is Null));"
CurrentDb.Execute strSQL


ExitDataHere:
If Err.Number = 0 Then
Exit Sub
End If

HandleDataErr:
' display a message with the error number and description
MsgBox "Error Num: " & Err.Number & " Desc: " & Err.Description

Resume ExitDataHere

End Sub

Private Sub Process_Rep_Data()
Dim rst As Recordset
Dim qdf As QueryDef
Dim prm As Parameter
Dim intContactsMade As Integer
Dim int1Time As Integer, int2Times As Integer, int3Times As Integer, int4Plus As Integer

On Error GoTo HandleProcessErr

intContactsMade = 0
int1Time = 0
int1Time2 = 0
int2Times = 0
int4Plus = 0

Set qdf = CurrentDb.QueryDefs("qryContactsMadeinDate_Prospects")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
rst.MoveLast
intContactsMade = rst.RecordCount
Else
intContactsMade = 0
End If
rst.Close
qdf.Close

Set qdf = CurrentDb.QueryDefs("qryTotAcctsinDate_Prospects")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
rst.MoveLast
Me!txtCtNumAccts = rst.RecordCount
Else
Me!txtCtNumAccts = 0
End If
rst.Close
qdf.Close


Me!txtProspNumAccts = (Me!txtCtNumAccts + Me!txtPriNumAccts)

Set qdf = CurrentDb.QueryDefs("qryTotAcctsinDate_Buyers")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
rst.MoveLast
Me!txtCtNumAccts2 = rst.RecordCount
Else
Me!txtCtNumAccts2 = 0
End If
rst.Close
qdf.Close

Set qdf = CurrentDb.QueryDefs("qryTotAccts_NonContacted")
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
rst.MoveLast
Me!txtNoCtNumAccts = rst.RecordCount
Else
Me!txtNoCtNumAccts = 0
End If
rst.Close
qdf.Close

Me!txtGTNumAccts = (Me!txtNumAcctsSub + Me!txtNoCtNumAccts)

Set qdf = CurrentDb.QueryDefs("qryTotOrdersinDate_Prospects")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
rst.MoveLast
Me!txtCtNumOrders = rst.RecordCount
Else
Me!txtCtNumOrders = 0
End If
rst.Close
qdf.Close


Me!txtProspNumOrders = (Me!txtCtNumOrders + Me!txtPriNumOrders)

Set qdf = CurrentDb.QueryDefs("qryTotOrders_NonContacted")
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
rst.MoveLast
Me!txtNoCtNumOrders = rst.RecordCount
Else
Me!txtNoCtNumOrders = 0
End If
rst.Close
qdf.Close

Me!txtGTNumOrders = (Me!txtNumOrdersSub + Me!txtNoCtNumOrders)

Set qdf = CurrentDb.QueryDefs("qryTotSalesinDate_Prospects")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
Me!txtCtTotSales = Nz(rst.Fields("TotalSales"), 0)
Else
Me!txtCtTotSales = 0#
End If
rst.Close
qdf.Close

Me!txtProspTotSales = (Me!txtCtTotSales + Me!txtPriTotSales)

Me!txtTotSalesSub = (Me!txtProspTotSales + Me!txtPastTotSales)

Set qdf = CurrentDb.QueryDefs("qryTotSales_NonContacted")
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
Me!txtNoCtTotSales = Nz(rst.Fields("TotalSales"), 0)
Else
Me!txtNoCtTotSales = 0#
End If
rst.Close
qdf.Close

Me!txtGTTotSales = (Me!txtTotSalesSub + Me!txtNoCtTotSales)

Me!txtCtNumContacts = intContactsMade
Me!txtNumContactsSub = (Me!txtCtNumContacts + Me!txtCtNumContacts2)
Me!txtGTNumContacts = Me!txtNumContactsSub

Set qdf = CurrentDb.QueryDefs("qryContactsperAcctDistr_Prospects")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
Do While Not rst.EOF
Select Case rst.Fields("ContactCount")
Case 1
int1Time = rst.Fields("Distribution")
Case 2
int2Times = rst.Fields("Distribution")
Case 3
int3Times = rst.Fields("Distribution")
Case 4
int4Plus = (int4Plus + rst.Fields("Distribution"))
Case Else
int4Plus = (int4Plus + rst.Fields("Distribution"))
End Select
rst.MoveNext
Loop
int4Plus = int4Plus
Else
int1Time = 0
int2Times = 0
int3Times = 0
int4Plus = 0
End If
rst.Close
qdf.Close


Me!txtCt1Time = int1Time
Me!txt1TimeSub = (Me!txtCt1Time + Me!txtCt1Time2)
Me!txtGT1Time = Me!txt1TimeSub

Me!txtCt2Times = int2Times
Me!txt2TimesSub = (Me!txtCt2Times + Me!txtCt2Times2)
Me!txtGT2Times = Me!txt2TimesSub

Me!txtCt3Times = int3Times
Me!txt3Timessub = (Me!txtCt3Times + Me!txtCt3Times2)
Me!txtGT3Times = Me!txt3Timessub

Me!txtCt4PlusTimes = int4Plus
Me!txt4PlusTimesSub = (Me!txtCt4PlusTimes + Me!txtCt4PlusTimes2)
Me!txtGT4PlusTimes = Me!txt4PlusTimesSub

Set qdf = CurrentDb.QueryDefs("qryCustsWhoPurch_Prospects")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
rst.MoveLast
Me!txtCTCustsPurch = rst.RecordCount
Else
Me!txtCTCustsPurch = 0
End If
rst.Close
qdf.Close

Me!txtCustsPurchSub = (Me!txtCTCustsPurch + Me!txtCTCustsPurch2)
Me!txtGTCustsPurch = Me!txtCustsPurchSub

ExitProcessHere:
' set any existing objects to nothing
If Not rst Is Nothing Then
Set rst = Nothing
End If
If Not prm Is Nothing Then
Set prm = Nothing
End If
If Not qdf Is Nothing Then
Set qdf = Nothing
End If

If Err.Number = 0 Then
Exit Sub
End If

HandleProcessErr:
' display a message with the error number and description
MsgBox "Error Num: " & Err.Number & " Desc: " & Err.Description

Resume ExitProcessHere

End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top