|
|
|
|
|
|
|
|
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ê
|
|
|
|
|
