Upgraded Reports Issue

[ralphralph07]

Hi

I have inherited a database and have upgraded it to 2003 and i have come across a problem with how a report is run that i can't seem to get to the bottom of!

The report menu has the following code attached to the print button but i need a way to get it to ask for the lab reference so that it prints just for the record i need.

I have tried putting a [labreference] in the control source but this doesn't print the correct information - it doesn't pick up the data associated with the record in the tables

Private Sub print_Click()
Dim print_response As Integer
Dim cond As String, repname As String

cond = DLookup("[macroname]", "Report Names", "[reptitle]=forms![report screen].[reptitle]")
repname = DLookup("[repname]", "Report Names", "[reptitle]=forms![report screen].[reptitle]")

    On Error Resume Next

DoCmd.OpenReport repname, A_NORMAL, , cond


DoCmd.SetWarnings False
On Error GoTo 0
If [reptitle] = "Report Analyses" Then
    print_response = MsgBox("Do you want to mark these Analyses as Printed ?, Y/N", 292, "Analysis Printout")
    If print_response = 6 Then DoCmd.OpenQuery "update print flag"
End If

If [reptitle] = "sample logging audit trail" Then
    print_response = MsgBox("Do you want to Update the logging audit file ?, Y/N", 292, "Analysis Printout")
    If print_response = 6 Then DoCmd.OpenQuery "update audit print flag"
End If



DoCmd.SetWarnings True
End Sub

The report also has the following code on that brings through the sub data

ption Compare Database   'Use database order for string comparisons
Dim res As Recordset
Dim st As Recordset
Global lab_ref As String

Sub prepare_title(rep_name As String, SAMP_TYPE As String, Site_ref As String)
Dim samplename As String




Reports(rep_name).[rep_title].Caption = DLookup("[ST_name]", "sample types", "[s_type] = '" & SAMP_TYPE & "'") & " - Analysis Report"

If SAMP_TYPE = "O" Then
Reports(rep_name).[rep_title].Caption = "Sample - Analysis Report"
End If

If Site_ref = "o" Then
    Reports(rep_name).[slash].Visible = False
    Reports(rep_name).[Site].Visible = False
End If

If SAMP_TYPE = "W" Then
    Reports(rep_name).[cont_enq_text].Visible = True
    Reports(rep_name).[cont_enq_text].Caption = "Enquiry"
    Reports(rep_name).[Enquiry].Visible = True
    Reports(rep_name).[producer_text].Visible = True
    Reports(rep_name).[Producer].Visible = True
    Reports(rep_name).[sample point text].Visible = False

End If

If SAMP_TYPE = "A" Then
    Reports(rep_name).[cont_enq_text].Visible = True
    Reports(rep_name).[cont_enq_text].Caption = "Contract"
    Reports(rep_name).[Contract].Visible = True
    Reports(rep_name).[producer_text].Visible = True
    Reports(rep_name).[Producer].Visible = True
End If

If SAMP_TYPE = "L" Or SAMP_TYPE = "GW" Or SAMP_TYPE = "SW" Or SAMP_TYPE = "O" Then
    Reports(rep_name).[customer_text].Caption = "Sampler"
    Reports(rep_name).[Site].Visible = True
    Reports(rep_name).[slash].Visible = True
    Reports(rep_name).[sample point text].Visible = True
    Else
    Reports(rep_name).[customer_text].Caption = "Customer"
End If

End Sub

Sub print_analysis(LabREF As String, Site As String, suite As String, stype As String, repname As String, Parameterquery)

'   This routine sets all of the test parameters used in suites to
'   invisible, then resets those used by the suite to visible.


'*********  SET VARIABLE AND PARAMETERS *****************
Dim mydb As Database, st As Recordset, res As Recordset, testname As String
Dim myc As Control, tgrp As String, resgrp As String, mysql As String
Dim current_group As String, lab_ref  As String
Dim equivalence  As String, testvalue As Double
Dim testuom As String, comments As String, print_pos As Integer


Set mydb = CurrentDb()
Set st = mydb.OpenRecordset(Parameterquery)
Set res = mydb.OpenRecordset("Results Parameters")



'**********    PREPARE REPORT TITLE   *******************
Call prepare_title(repname, stype, Site)

'*********** SET BOXES TO "M" AND MAKE INVISIBLE ***********
For j = 1 To 44
Reports(r_name)("box" + Str$(j)).Visible = False
Reports(r_name)("box" + Str$(j)).Caption = "M"
Reports(r_name)("eq" + Str$(j)).Visible = False
Reports(r_name)("eq" + Str$(j)).Caption = "M"
Reports(r_name)("val" + Str$(j)).Visible = False
Reports(r_name)("val" + Str$(j)).Value = "M"
Reports(r_name)("uom" + Str$(j)).Visible = False
Reports(r_name)("uom" + Str$(j)).Caption = "M"
Reports(r_name)("com" + Str$(j)).Visible = False
Reports(r_name)("com" + Str$(j)).Caption = "M"
Next

'*********** SET BOTH RECORDSETS TO FIRST RECORD ***********
res.MoveFirst
st.MoveFirst
current_group = "General"



'**********  CYCLE THROUGH BOXES UP TO 44 ******************
For I = 1 To 44
    print_pos = I
  

check_eof:
If st.EOF Then                           'check for last result record
    If res.EOF Then
        Exit Sub
        End If
End If

If res.EOF Then GoTo print_standard


If res![Lab Ref No] = LabREF Then
    GoTo process_labref
    Else
    res.MoveNext
    GoTo check_eof
End If

process_labref:
If st.EOF Then GoTo print_results

resgrp = res!t_grp
tgrp = st!t_grp
tpos = st!f_pos
respos = res!f_pos


If resgrp > tgrp Then GoTo print_standard
If resgrp < tgrp Then GoTo print_results
If resgrp = tgrp Then GoTo compare_positions
MsgBox "error in group sorting"


compare_positions:
    If tpos > respos Then GoTo print_results          'compare print positions
    If tpos < respos Then GoTo print_standard         ' and print the lowest
    If tpos = respos Then GoTo print_both
    MsgBox "error in position sorting"


print_results:
    If res!t_grp > current_group Then
        print_pos = print_pos + 1
        I = I + 1
    End If
    equivalence = res!Equiv
    testvalue = res!Value
    testuom = res!UOM
        
        If IsNull(res!p_comm) Then
            comments = " "
        Else
            comments = res!p_comm
        End If

    current_group = res!t_grp                          'set current group to
    testname = res!T_name
    Call PrintResultValues(LabREF, repname, testname, equivalence, testvalue, testuom, comments, print_pos)
    res.MoveNext                              ' one being printed
    GoTo last_line

print_standard:
    If st!t_grp > current_group Then
        I = I + 1
        print_pos = print_pos + 1
    End If
    testname = st!T_name
    current_group = st!t_grp    'set current group to one being printed
    Call Printst(repname, testname, print_pos)     'PRINT st TEXT
    'MsgBox "current group is now " & current_group
    st.MoveNext                                    'MOVENEXT st
    GoTo last_line


print_both:
    If res!t_grp > current_group Then
        I = I + 1
        print_pos = print_pos + 1
    End If
    current_group = res!t_grp          'set current group to one being printed
    testname = res!T_name
    equivalence = res!Equiv
    testvalue = res!Value
    testuom = res!UOM
        
        If IsNull(res!p_comm) Then
            comments = " "
        Else
            comments = res!p_comm
        End If
    
    Call PrintResultValues(LabREF, repname, testname, equivalence, testvalue, testuom, comments, print_pos)
    res.MoveNext
    st.MoveNext
    GoTo last_line
        
        
last_line:
    'If resgrp > current_group Then             'Check for new group and
     '   If tgrp > current_group Then I = I + 1   'leave space if true
    'End If

check_nomatch:
    If res!EOF = True Then
        If st!EOF = True Then
          Exit Sub
     End If
    End If

skip_record:
Next

Exit Sub

End Sub

Sub PrintResultValues(lab_ref As String, repname As String, testname As String, Equiv As String, test_val As Double, UOM As String, pcomments As String, p_pos As Integer)
Dim parabox As String, equivbox As String, valbox As String
Dim uombox As String, commbox As String

parabox = "box" + Str$(p_pos)
equivbox = "eq" + Str$(p_pos)
valbox = "val" + Str$(p_pos)
uombox = "uom" + Str$(p_pos)
commbox = "com" + Str$(p_pos)


Reports(repname)(parabox).Visible = True
Reports(repname)(parabox).Caption = testname

If Equiv <> "=" Then
    Reports(repname)(equivbox).Visible = True
    Reports(repname)(equivbox).Caption = Equiv
End If

If test_val <> 0 Then
    Reports(repname)(valbox).Visible = True
    Reports(repname)(valbox).Value = test_val
    Reports(repname)(uombox).Visible = True
    Reports(repname)(uombox).Caption = UOM
End If

Reports(repname)(commbox).Visible = True
Reports(repname)(commbox).Caption = pcomments


End Sub

Sub Printst(repname1 As String, testname1, p_pos1)
Dim parabox1 As String


parabox1 = "box" + Str$(p_pos1)



Reports(repname1)(parabox1).Visible = True
Reports(repname1)(parabox1).Caption = testname1

End Sub

I can see what the code is doing but can't seem to get it to work how it did before the upgrade and I haven't changed anything that would impact it

THanks

Ralph