USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Dicas

  Visual Basic    (Crystal Reports)

Título da Dica:  Abrindo relatórios, Aplicando Filtros, Definindos valores de Formulas no Crystal 8.5
Postada em 23/11/2003 por Riciê            
Ai Galera,

    Vai uma rotina quente para abertura de relatórios no Crystal report

Declare no Módulo :

'Declaração do Cristal Report
Public Crys As New CRAXDRT.Application
Public Report As CRAXDRT.Report
Public SubReport As CRAXDRT.Report
Public Table As CRAXDRT.DatabaseTable

'Variáveis de Abertura de Relatórios
Public RPTRel As String, FormulaRel() As String, SqlRel As String, SubReportRel As String
Public TituloRel As String, CampoRel As String, FiltroRel As String, FiltroSubRel As String, SqlSubRel As String

Public Sub Imprimir(NomeRPT As String, NomeSubReport As String, Titulo As String, CRFiltro As String, CRSubFiltro As String, Campo As String, Posição As Byte, MFormula() As String, CRSqlRel As String, CRSqlSubRel As String, Papel As String, F As Form, Barra As Boolean, Saída As Integer)
Dim DataField As CRAXDRT.DatabaseFieldDefinition
Dim DataFormula As CRAXDRT.FormulaFieldDefinition
Dim Formulas As CRAXDRT.FormulaFieldDefinitions
Dim Formula As CRAXDRT.FormulaFieldDefinition
Dim rsReport As New ADODB.Recordset
Dim rsSubReport As New ADODB.Recordset

   Screen.MousePointer = 11
   'Localiza a Base de Dados do Report
   AbrirRs rsReport, CRSqlRel, 0
   If rsReport.RecordCount = 0 Then
      MsgBox "Não existe(m) dado(s) a ser(em) exibido(s) !", 48, "Destak Comercial"
      MsgPanel Empty
      Screen.MousePointer = 0
      Exit Sub
   End If
   MsgPanel IIf(Saída = 1, "Abrindo Relatório ...", "Imprimindo Relatório ...")
   F.MVisual(1).Enabled = False
   F.MVisual(2).Enabled = False
   If Barra Then
      F.tlbBarra2.Buttons("Visualizar").Enabled = False
      F.tlbBarra2.Buttons("Imprimir").Enabled = False
   End If
   Set Report = Crys.OpenReport(NomeRPT, 1)
   Report.Database.SetDataSource rsReport, 3, 1
   Report.Database.Verify
  
   'Localiza a Base de Dados do SubReport
   If NomeSubReport <> "" Then
      Set SubReport = Report.OpenSubreport(NomeSubReport)
      AbrirRs rsSubReport, CRSqlSubRel, 0
      SubReport.Database.SetDataSource rsSubReport, 3, 1
      SubReport.Database.Verify
      SubReport.RecordSelectionFormula = CRSubFiltro
   End If
  
   'Associa o Report ao Controle
   Visualização.Cr.ReportSource = Report
   Visualização.Caption = Titulo
   Report.ReportTitle = Titulo
      
   'Classificação do Relatório
   If Campo <> Empty Then
      Set DataField = Report.Database.Tables.Item(Posição).Fields.GetItemByName(Campo)
      Report.RecordSortFields.Add DataField, crAscendingOrder
   End If
  
   'Filtro do Relatório
   Report.RecordSelectionFormula = CRFiltro
   'Formulas do Relatório
   If UBound(FormulaRel, 2) > 0 Then
      Set Formulas = Report.FormulaFields
      For Each Formula In Formulas
         For X = 1 To UBound(FormulaRel, 2)
            If Formula.Name = MFormula(1, X) Then
               Formula.Text = MFormula(2, X)
               Exit For
            End If
         Next
      Next
   End If
   'Configura Tamanho do Papel
   Report.PaperSize = IIf(Papel = "A4", crPaperA4, crPaperLetter)
  
   'Abre o Relatório
   If Saída = 1 Then
      Visualização.Cr.ViewReport
      Screen.MousePointer = 0
      Visualização.Show 1
   ElseIf Saída = 2 Then
      Report.PrinterSetup 0
      Report.PrintOut
   End If
   FecharRs rsReport
   Set Report = Nothing
   Set SubReport = Nothing
   F.MVisual(1).Enabled = True
   F.MVisual(2).Enabled = True
   If Barra Then
      F.tlbBarra2.Buttons("Visualizar").Enabled = True
      F.tlbBarra2.Buttons("Imprimir").Enabled = True
   End If
   MsgPanel Empty
   Screen.MousePointer = 0
End Sub

Public Sub LimparVariáveis()
   RPTRel = ""
   TituloRel = ""
   ReDim FormulaRel(0 To 0, 0 To 0)
   CampoRel = ""
   FiltroRel = ""
   FiltroSubRel = ""
   SqlRel = ""
   SubReportRel = ""
   SqlSubRel = ""
End Sub

'Para Abrir o relatório crie a rotina em um formulário

Private Sub Visualizar(Saída As Integer)
   Dim Filtro As String
   Screen.MousePointer = 11
   LimparVariáveis
   TituloRel = "Relatório de Produtos"
   SqlRel = "SELECT * FROM T017"
   CampoRel = "Produto"
   Filtro = "{T017.CodProduto} > 2 AND {T017.Excluído} = 0 AND   {T017.Tipo} = 1" & IIf(optFiltro(0).Value, " AND {T017.Categoria} = '" & dbcCategoria.Text & "'", "")
   SqlRel = SqlRel & " WHERE T017.CodProduto > 2 AND T017.Excluído = 0 AND T017.Tipo = 1" & IIf(optFiltro(0).Value, " AND T017.Categoria = '" & dbcCategoria.Text & "'", "")
   RPTRel = App.Path & "\R054.rpt"
   FiltroRel = Filtro
   ReDim FormulaRel(1 To 2, 1 To 2)
   FormulaRel(1, 1) = "{@Título}"
   FormulaRel(2, 1) = "'Tabela de Preços - " & rsConfig!NomeCliente & "'"
   FormulaRel(1, 2) = "{@End}"
   FormulaRel(2, 2) = "'" & rsConfig!Endereço & " - " & rsConfig!Cidade & " / " & rsConfig!UF & "'"
   Imprimir RPTRel, "", TituloRel, FiltroRel, "", CampoRel, 1, FormulaRel, SqlRel, "", "Carta", Me, True, Saída
   Screen.MousePointer = 0

Obs. Você deverá criar um formulário no e incluir o controle do Crystal reports nele (Form Visualização)

Até mais,

       Riciê
 


CyberWEB Network Ltda.    © Copyright 2000-2022   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página