how to code to display simultaneous crystal report in vb6 ?

Collapse
X
 
  • Time
  • Show
Clear All
new posts
  • niravpatwa
    New Member
    • Dec 2010
    • 1

    how to code to display simultaneous crystal report in vb6 ?

    I have write this code :


    Dim strSqlValid
    Dim objConn1 As ADODB.Connectio n
    Dim objRS1 As ADODB.Recordset
    Dim objRS2 As ADODB.Recordset
    Dim objRSItem As ADODB.Recordset
    Dim formula As String
    Dim Appl As New CRAXDRT.Applica tion
    Dim rptReport As New CRAXDRT.Report
    Dim sReportName As String
    Dim gstrDatabaseNam e As String
    Dim gstrUserName As String
    Dim gstrPassword As String
    Dim comp As String
    Dim i As Integer
    Dim k As Integer
    Dim strTemp As String
    Dim strSplit() As String


    Private Sub Form_Load()

    ' common code start

    comp = "500"
    gstrDatabaseNam e = "baantest"
    gstrUserName = "web"
    gstrPassword = "web123"

    ' set screen
    CR1.Top = 10
    CR1.Left = 0
    CR1.Height = Screen.Height - 1000
    CR1.Width = Screen.Width
    Screen.MousePoi nter = vbHourglass

    Set objConn1 = CreateObject("A DODB.Connection ")
    Set objRS1 = CreateObject("A DODB.Recordset" )
    Set objRS2 = CreateObject("A DODB.Recordset" )
    Set objRSItem = CreateObject("A DODB.Recordset" )

    objConn1.Open "Provider=MSDAS QL.1;Persist Security Info=False;Data Source=baantest ", "web", "web123"

    ' get value from the main form
    strSplit = Split(frmInvent oryTransactions .lblQMSProject. Caption, " ")
    lblQMSProject.C aption = strSplit(0)
    lblSeam.Caption = frmInventoryTra nsactions.lblSe am.Caption
    lblItem.Caption = Mid$(frmInvento ryTransactions. lblItem.Caption , 1, 16)

    'common code end

    ' getting 10th character of the item code which defines the welding process.
    strTemp = Mid$(lblItem.Ca ption, 10, 1)
    'MsgBox (strTemp)

    ' for SMAW
    If (strTemp = "E" Or strTemp = "e") Then
    sReportName = "SMAW.rpt"

    strSqlValid = "SELECT * FROM ttiitm001500"
    strSqlValid = strSqlValid & " WHERE t_item = '" & lblItem.Caption & "'"
    Set objRSItem = objConn1.Execut e(strSqlValid)

    Appl.LogOnServe r "pdsodbc.dl l", gstrDatabaseNam e, "", gstrUserName, gstrPassword
    Set rptReport = Appl.OpenReport (App.Path & "\" & sReportName)
    rptReport.Disca rdSavedData
    For i = 1 To rptReport.Datab ase.Tables.Coun t
    'MsgBox (rptReport.Data base.Tables(1). Name)
    rptReport.Datab ase.LogOnServer "pdsodbc.dl l", gstrDatabaseNam e, "", gstrUserName, gstrPassword
    Next i

    If (objRSItem.BOF And objRSItem.EOF) Then
    Else
    objRSItem.MoveF irst

    strSqlValid = "SELECT * FROM tltwps021500"
    strSqlValid = strSqlValid & " WHERE t_cprj ='" & lblQMSProject.C aption & "'"
    strSqlValid = strSqlValid & " and t_seam = '" & lblSeam.Caption & "' "
    strSqlValid = strSqlValid & " and (t_con1 = '" & Trim(objRSItem. Fields("t_seab" ).Value) & "' "
    strSqlValid = strSqlValid & " or t_con2 = '" & Trim(objRSItem. Fields("t_seab" ).Value) & "' "
    strSqlValid = strSqlValid & " or t_con3 = '" & Trim(objRSItem. Fields("t_seab" ).Value) & "' "
    strSqlValid = strSqlValid & " or t_con4 = '" & Trim(objRSItem. Fields("t_seab" ).Value) & "') "
    Set objRS1 = objConn1.Execut e(strSqlValid)

    objRS1.MoveFirs t

    'k = 0

    Do While (objRS1.BOF <> True And objRS1.EOF <> True)

    'MsgBox (objRS1.Fields( "t_wpsn").Value )

    formula = "{tltwps021500. t_cprj} = '" & lblQMSProject.C aption & "' and {tltwps021500.t _wpsn} = '" & Trim(objRS1.Fie lds("t_wpsn").V alue) & "' and {tltwps021500.t _seam} = '" & lblSeam.Caption & "' and ({tltwps021500. t_con1} = '" & Trim(objRS1.Fie lds("t_con1").V alue) & "' or {tltwps021500.t _con2} = '" & Trim(objRS1.Fie lds("t_con2").V alue) & "' or {tltwps021500.t _con3} = '" & Trim(objRS1.Fie lds("t_con3").V alue) & "' or {tltwps021500.t _con4} = '" & Trim(objRS1.Fie lds("t_con4").V alue) & "') "
    'rptReport.Form ulaFields(1).Te xt = """Testing Name"""
    rptReport.Recor dSelectionFormu la = formula

    'ReDim Preserve rptReport(0 To k) As New CRAXDRT.Report

    If Trim(UCase(objR S1.Fields("t_co n1").Value)) = Trim(UCase(objR SItem.Fields("t _seab").Value)) Then
    rptReport.Formu laFields(1).Tex t = "'" & objRS1.Fields(" t_lsq1").Value & "'"
    rptReport.Formu laFields(2).Tex t = "'" & objRS1.Fields(" t_con1").Value & "'"
    rptReport.Formu laFields(3).Tex t = "'" & objRS1.Fields(" t_brnd").Value & "'"
    rptReport.Formu laFields(4).Tex t = "'" & objRS1.Fields(" t_ffno1").Value & "'"
    rptReport.Formu laFields(5).Tex t = "'" & objRS1.Fields(" t_siz1").Value & "'"
    rptReport.Formu laFields(6).Tex t = "'" & objRS1.Fields(" t_cur1").Value & "'"
    rptReport.Formu laFields(7).Tex t = "'" & objRS1.Fields(" t_vlt1").Value & "'"
    rptReport.Formu laFields(8).Tex t = "'" & objRS1.Fields(" t_pltp1").Value & "'"
    rptReport.Formu laFields(9).Tex t = "'" & objRS1.Fields(" t_bln1").Value & "'"
    rptReport.Formu laFields(10).Te xt = "'" & objRS1.Fields(" t_tsp1").Value & "'"
    ElseIf Trim(UCase(objR S1.Fields("t_co n2").Value)) = Trim(UCase(objR SItem.Fields("t _seab").Value)) Then
    rptReport.Formu laFields(1).Tex t = "'" & objRS1.Fields(" t_lsq2").Value & "'"
    rptReport.Formu laFields(2).Tex t = "'" & objRS1.Fields(" t_con2").Value & "'"
    rptReport.Formu laFields(3).Tex t = "'" & objRS1.Fields(" t_brn2").Value & "'"
    rptReport.Formu laFields(4).Tex t = "'" & objRS1.Fields(" t_ffno2").Value & "'"
    rptReport.Formu laFields(5).Tex t = "'" & objRS1.Fields(" t_siz2").Value & "'"
    rptReport.Formu laFields(6).Tex t = "'" & objRS1.Fields(" t_cur2").Value & "'"
    rptReport.Formu laFields(7).Tex t = "'" & objRS1.Fields(" t_vlt2").Value & "'"
    rptReport.Formu laFields(8).Tex t = "'" & objRS1.Fields(" t_pltp2").Value & "'"
    rptReport.Formu laFields(9).Tex t = "'" & objRS1.Fields(" t_bln1").Value & "'"
    rptReport.Formu laFields(10).Te xt = "'" & objRS1.Fields(" t_tsp2").Value & "'"
    ElseIf Trim(UCase(objR S1.Fields("t_co n3").Value)) = Trim(UCase(objR SItem.Fields("t _seab").Value)) Then
    rptReport.Formu laFields(1).Tex t = "'" & objRS1.Fields(" t_lsq3").Value & "'"
    rptReport.Formu laFields(2).Tex t = "'" & objRS1.Fields(" t_con3").Value & "'"
    rptReport.Formu laFields(3).Tex t = "'" & objRS1.Fields(" t_brn3").Value & "'"
    rptReport.Formu laFields(4).Tex t = "'" & objRS1.Fields(" t_ffno3").Value & "'"
    rptReport.Formu laFields(5).Tex t = "'" & objRS1.Fields(" t_siz3").Value & "'"
    rptReport.Formu laFields(6).Tex t = "'" & objRS1.Fields(" t_cur3").Value & "'"
    rptReport.Formu laFields(7).Tex t = "'" & objRS1.Fields(" t_vlt3").Value & "'"
    rptReport.Formu laFields(8).Tex t = "'" & objRS1.Fields(" t_pltp3").Value & "'"
    rptReport.Formu laFields(9).Tex t = "'" & objRS1.Fields(" t_bln3").Value & "'"
    rptReport.Formu laFields(10).Te xt = "'" & objRS1.Fields(" t_tsp3").Value & "'"
    ElseIf Trim(UCase(objR S1.Fields("t_co n4").Value)) = Trim(UCase(objR SItem.Fields("t _seab").Value)) Then
    rptReport.Formu laFields(1).Tex t = "'" & objRS1.Fields(" t_lsq4").Value & "'"
    rptReport.Formu laFields(2).Tex t = "'" & objRS1.Fields(" t_con4").Value & "'"
    rptReport.Formu laFields(3).Tex t = "'" & objRS1.Fields(" t_brn4").Value & "'"
    rptReport.Formu laFields(4).Tex t = "'" & objRS1.Fields(" t_ffno4").Value & "'"
    rptReport.Formu laFields(5).Tex t = "'" & objRS1.Fields(" t_siz4").Value & "'"
    rptReport.Formu laFields(6).Tex t = "'" & objRS1.Fields(" t_cur4").Value & "'"
    rptReport.Formu laFields(7).Tex t = "'" & objRS1.Fields(" t_vlt4").Value & "'"
    rptReport.Formu laFields(8).Tex t = "'" & objRS1.Fields(" t_pltp4").Value & "'"
    rptReport.Formu laFields(9).Tex t = "'" & objRS1.Fields(" t_bln4").Value & "'"
    rptReport.Formu laFields(10).Te xt = "'" & objRS1.Fields(" t_tsp4").Value & "'"
    End If
    Set objRS2 = CreateObject("A DODB.Recordset" )
    strSqlValid = "SELECT * from ttclnt055500"
    strSqlValid = strSqlValid & " WHERE t_cprj ='" & lblQMSProject.C aption & "'"
    strSqlValid = strSqlValid & " and t_seam = '" & lblSeam.Caption & "'"
    strSqlValid = strSqlValid & " and (t_wpsn = '" & lblWpsn.Caption & "'"
    strSqlValid = strSqlValid & " or t_wpsa = '" & lblWpsn.Caption & "'"
    strSqlValid = strSqlValid & " or t_wpsb = '" & lblWpsn.Caption & "')"
    Set objRS2 = objConn1.Execut e(strSqlValid)
    If (objRS2.BOF And objRS2.EOF) Then
    Else
    objRS2.MoveFirs t
    rptReport.Formu laFields(11).Te xt = "'" & objRS2.Fields(" t_nots").Value & "'"
    End If

    'CR1.Refresh
    'Exit Sub
    'Set rptReport = Nothing
    objRS1.MoveNext
    Loop
    End If
    End If

    ' common code start
    objConn1.Close
    Set objConn1 = Nothing
    CR1.ReportSourc e = rptReport
    CR1.ViewReport
    Screen.MousePoi nter = vbDefault
    ' common code end

    End Sub



    the query " select * from tltwps021500... ." gets 2 records.

    The problem is that it shows me only one report of last
    record. It doesn't show me the two reports of two records.

    I have also attach text file of the above code..

    if anyone find solution of this code pls reply as early as possible.

    and thanks in advance...
    Attached Files
Working...