SUB-RELATÓRIO CRYSTAL REPORT XI E VB6

 Tópico anterior Próximo tópico Novo tópico

SUB-RELATÓRIO CRYSTAL REPORT XI E VB6

VB.NET

 Compartilhe  Compartilhe  Compartilhe
#476812 - 27/09/2017 12:51:36

TRTNCG
CAMPINA GRANDE
Cadast. em:Fevereiro/2004


Última edição em 27/09/2017 14:13:37 por TRTNCG

Olá Srs, Boa Tarde! Estou com uma probleminha será que poderiam me ajudar. Bom, estou personalizando um relatório de associados que neste contém um sub-relatório. O relatório principal está ok, no entanto não estou conseguindo filtrar os dependentes de acordo com o ID do relatório principal. Segue imagem em anexo.




• SQL do Subrelatorio
sql2 = "SELECT D.* FROM dependentes AS D"
sql2 = sql2 & "LEFT join associados_dependentes AS ad ON AD.ASD_ID_DEPENDENTE=D.DE_ID"
sql2 = sql2 & " Left join associados as A on A.AS_ID=AD.ASD_ID_ASSOCIADO"
sql2 = sql2 & " WHERE AD.ASD_ID_ASSOCIADO=" & txt_codigo.Text & " Order by D.DE_NOME"

ROTINA PARA CHAMAR O RELATÓRIO PRINCIPAL:

Public Sub Imprimir_Ficha_Filiacao()

sql = "Select A.*,E.EM_FANTASIA as NOME_EMPRESA,FA.FA_FOTOGRAFIA,CF.CARGOS_FUNCOES_NOME as NOME_FUNCAO from associados as A"
sql = sql & " Left join EMPRESAS As E on A.AS_VINCULO_EMPRESA=EM_ID"
sql = sql & " Left join FOTOS_ASSOCIADOS as FA on FA_ID_ASSOCIADO=A.AS_ID"
sql = sql & " left join cargos_funcoes as CF on CF.CARGOS_FUNCOES_ID=A.AS_FUNCAO_CARGO"
sql = sql & " Where A.AS_EXCLUIDO=0 and A.AS_ID=" & txt_codigo.Text & ""

Call AbrirRPT("RFICHA.rpt", sql, "", "", "", "" , "FICHA DE FILIAÇÃO", "Ficha de Filiação", True, 0, sql2)

End Sub

• ROTINA ABRIR RPT

Public Sub AbrirRPT(ByVal NomeDoRelatorio As String, ByVal ComandoSQL As String, ByVal TituloPrincipalDoRelatorio As String, _
ByVal SubTitulo1 As String, ByVal SubTitulo2 As String, ByVal SubTitulo3 As String, ByVal DescricaoDoRelatorio As String, ByVal TituloDaJanela As String, ByVal ZoomPadrao As Boolean, ByVal ZoomRelatorio As Integer, ByVal SSQL_SubRelatorio As String)
    
    'On Error GoTo Tratar
    
    '=========== Verifica se a SQL retornou pelos menos 1 registro para visualização do relatório ===============
    
    If Banco.State = 0 Then Banco.Open
  
    Call AntesDeImprimir(ComandoSQL)
        
     If VisualizarRPT = True Then
        
            Dim VAR As String
            Dim TBREL As ADODB.Recordset
            Dim TSUBREL As ADODB.Recordset
            Dim Crystal As New CRAXDRT.Application
            Dim Report As CRAXDRT.Report
            Dim oSubReport As CRAXDRT.Report

            Dim i As Integer
            Dim NomeFormula As String

        
            Set TBREL = New ADODB.Recordset
            
               '============= Rotina para verificar se o arquivo existe  ===================
                If Dir$(App.Path & "\Personalizados\" & NomeDoRelatorio) <> "" Then
                    Set Report = Crystal.OpenReport(App.Path & "\Personalizados\" & NomeDoRelatorio)
                Else
                    'If Dir$(App.Path & "\RPTS\" & NomeDoRelatorio) = "" Then
                    If Dir$("C:\Users\Thiago\Desktop\Professional Syndicate\RPTS\" & NomeDoRelatorio) = "" Then
                        MsgBox "O arquivo " & NomeDoRelatorio & " não foi localizado na pasta do sistema.", vbCritical, "Informativo"
                        Exit Sub
                    Else
                        'Set Report = Crystal.OpenReport(App.Path & "\RPTS\" & NomeDoRelatorio)
                        Set Report = Crystal.OpenReport("C:\Users\Thiago\Desktop\Professional Syndicate\RPTS\" & NomeDoRelatorio)
                    End If
                End If

            Debug.Print ComandoSQL
            
            TBREL.Open ComandoSQL, Banco, adOpenDynamic, adLockOptimistic
            
            Report.Database.SetDataSource TBREL
                      
           For i = 1 To Report.FormulaFields.Count
    
                NomeFormula = Report.FormulaFields.Item(i).name
    
                If NomeFormula = "{@TituloPrincipal}" Then
                    If TituloPrincipalDoRelatorio <> "" Then
                        Report.FormulaFields.Item(i).Text = "'" & TituloPrincipalDoRelatorio & "'"
                    Else
                        Report.FormulaFields.Item(i).Text = ""
                    End If
                End If
            
                If NomeFormula = "{@SubTitulo1}" Then
                    If SubTitulo1 <> "" Then
                        Report.FormulaFields.Item(i).Text = "'" & SubTitulo1 & "'"
                    Else
                        Report.FormulaFields.Item(i).Text = ""
                    End If
                End If
                
                If NomeFormula = "{@SubTitulo2}" Then
                    If SubTitulo2 <> "" Then
                        Report.FormulaFields.Item(i).Text = "'" & SubTitulo2 & "'"
                    Else
                        Report.FormulaFields.Item(i).Text = ""
                    End If
                End If
                
                  If NomeFormula = "{@SubTitulo3}" Then
                    If SubTitulo3 <> "" Then
                        Report.FormulaFields.Item(i).Text = "'" & SubTitulo3 & "'"
                    Else
                        Report.FormulaFields.Item(i).Text = ""
                    End If
                End If
                
                  If NomeFormula = "{@DescricaoRelatorio}" Then
                    If DescricaoDoRelatorio <> "" Then
                        Report.FormulaFields.Item(i).Text = "'" & DescricaoDoRelatorio & "'"
                    Else
                        Report.FormulaFields.Item(i).Text = ""
                    End If
                End If
            
            Next i
            
                TELA_RELATORIO.CR.Top = 0
                TELA_RELATORIO.CR.Left = 0
                TELA_RELATORIO.CR.Height = TELA_PRINCIPAL.ScaleHeight
                TELA_RELATORIO.CR.Width = TELA_PRINCIPAL.ScaleWidth
                    
                TELA_RELATORIO.CR.ReportSource = Report
                TELA_RELATORIO.CR.ViewReport
                TELA_RELATORIO.CR.Refresh
                TELA_RELATORIO.Caption = TituloDaJanela
                    
                If ZoomPadrao = True Then
                    TELA_RELATORIO.CR.Zoom (57)
                Else
                    TELA_RELATORIO.CR.Zoom (IIf(ZoomRelatorio <> "", ZoomRelatorio, 100))
                End If
                
                TELA_RELATORIO.Show 1
                
            TBREL.Close
          
            Set TBREL = Nothing
            Set Crystal = Nothing
            Set Report = Nothing
            
            If Banco.State = 1 Then Banco.Close
Else
    Exit Sub
End If

No crystal XI R2 já está linkado bonitinho, está mostrando como quero, o problema é quando chamo da minha aplicação, tenho que passar um parâmetro para o subrelatório de nome Pm-Comando.AS_ID. Pois toda vez que chamo o rel pela aplicação ele chama uma tela pedindo o ID e acredito eu que passando o id no parâmetro gera automático. Estou ficando doido





 Tópico anterior Próximo tópico Novo tópico


Tópico encerrado, respostas não sao permitidas
Encerrado por TRTNCG em 13/10/2017 17:10:15