Ver Mensaje Individual
  #5 (permalink)  
Antiguo 28/02/2007, 19:16
lotusxxl
 
Fecha de Ingreso: junio-2002
Mensajes: 243
Antigüedad: 21 años, 10 meses
Puntos: 1
Re: Subreport Crystal Reports XI

Bueno os pongo el código completo... que llama a un reprote y 2 subreportes...

Código:
Dim objReportApp As New CRAXDRT.Application
Dim objReport As CRAXDRT.Report
Dim objReportInner As CRAXDRT.Report
Dim objDatabaseTable As CRAXDRT.DatabaseTable
Dim objDatabase As CRAXDRT.Database
Dim objSections As CRAXDRT.Sections
Dim objSection As CRAXDRT.Section
Dim objReportObjs As CRAXDRT.ReportObjects
Dim objReportObj As Object
Dim objSubReport As CRAXDRT.SubreportObject

Dim sentencia As String
Dim rs As New ADODB.Recordset
Dim rsSub1 As New ADODB.Recordset
Dim rsSub2 As New ADODB.Recordset

Set conn = New ADODB.Connection
conn.CursorLocation = adUseClient
conn.ConnectionString = conexion
conn.Open


sentencia = " consulta del report "

Set rs = conn.Execute(sentencia)

' setup the report objects
Set objReport = objReportApp.OpenReport(App.Path & "\report.rpt")
        
' indicate we want the status window to display
objReport.DisplayProgressDialog = True
        


' ****************************** Subreport ***********************************
              
' set the database for the subreport(s) in the report
' set the section object to reference the report sections
Set objSections = objReport.Sections
        
' scan through all the sections in the report
For Each objSection In objSections
    ' set a reference to the report object found in the current Sections
    Set objReportObjs = objSection.ReportObjects
               
    ' scan through the current object found in the current Section
    For Each objReportObj In objReportObjs
        ' check if the current object in the current section is a subreport
        If objReportObj.Kind = crSubreportObject Then
            ' set a reference to this sub report
            Set objSubReport = objReportObj
            Set objReportInner = objSubReport.OpenSubreport
            objReportInner.DiscardSavedData
                    
            If objSubReport.SubreportName = "titol" Then
                        
                sentencia = "consulta subreporte 1"
                        
                Set rsSub1 = conn.Execute(sentencia)
                        
            Else
                sentencia = "consulta subreporte 2"
                
                Set rsSub2 = conn.Execute(sentencia)
        
            End If
            
            ' scan through each table in the subreport
            For Each objDatabaseTable In objReportInner.Database.Tables
                If objSubReport.SubreportName = "subreporte1" Then
                    objDatabaseTable.SetDataSource rsSub1
                Else
                    objDatabaseTable.SetDataSource rsSub2
                End If
            Next objDatabaseTable
        End If
    Next objReportObj
Next objSection

'**********************************************************************************

objReport.DiscardSavedData

' set the database to use for this report
For Each objDatabaseTable In objReport.Database.Tables
    objDatabaseTable.SetDataSource rs
Next objDatabaseTable

crViewer.ReportSource = objReport

objReport.FormulaFields(4).Text = var1


crViewer.ViewReport
crViewer.Zoom 100
Screen.MousePointer = vbDefault
Espero que le sirva a alguien de algo....

Salu2