VISUAL REPORTX

 Option Explicit

Private Rs As ADODB.Recordset

' Método para chamar o relatorio.
' Dessa forma todo o codigo para o funcionamento
' do relatorio pode ficar encapsulado no proprio formulario
[c]Public Sub Config()

    Dim Cn As String
        
    ' Uso do ADO nesse exemplo
    Set Rs = New ADODB.Recordset
    
    ' Define a conexão. Pode ser usado uma conexao
    ' ja aberta pelo sistema.
    Cn = "Provider=ZStyle IBOLE Provider;Password=masterkey;User ID=SYSDBA;SQL Dialect=3; Logging Level=0;Silent mode=True;CharacterSet=WIN1251;Data Source=" & "C:\SisPac\bdsistema.gdb"

    ' Abre o recordset com os dados
     Rs.Open "SELECT * from cad_ficha where id_ficha= " & Identificador, Cn, adOpenStatic, adLockOptimistic

  '  Associa o recordset ao relatorio
    Set Relatorio.Recordset = Rs
    ' Inicia a geração do relatório.
    Relatorio.Ativar
    
    ' Fecha o recordset
    Rs.Close
    Set Rs = Nothing
    
    ' Retira o formulário de relatorio da memória
    Unload Me
    
End Sub

Private Sub Relatorio_Erro(ByVal Numero As Long)
    
    ' O componente trabalha no modo silencioso para
    ' erros. Ele dispara esse evento Erro e sai. Caso
    ' o seu relatório esteja iniciando e saindo sem
    ' apresentar erro, verifique se você colocou algum
    ' código nesse evento.

    Rpx_MsgErro Numero
    
End Sub

Private Sub Relatorio_FormulaCampo(ByVal Campo As String, Valor As Variant)

Select Case Campo
        Case "TotalConsumoGeral"
        SomaValorConsumo = SomaValorConsumo + Relatorio.Recordset("TotalConsumo")
End Select

End Sub

Private Sub Relatorio_FormulaGrupo(ByVal Ordem As Byte, Valor As Variant)
    
    ' Indica que o grupo irá quebrar a cada novo codigo
    ' do pedido. Verifica se é formula para o grupo 1 ou
    ' para o grupo 2. Nesse caso o grupo 2 nao tem quebra
    ' apenas o grupo 1.
    If Ordem = 1 Then
        Valor = Relatorio.Recordset("Pedido")
    End If
    
End Sub

Private Sub Relatorio_ImprimiuRegistro(Cancelar As Boolean)

    If Det.BackColor = vbWhite Then
        Det.BackColor = &HE0E0E0
    Else
        Det.BackColor = vbWhite
    End If

End Sub

Private Sub Relatorio_IniciarRelatorio(ByVal Impressora As Boolean, Cancelar As Boolean)
    
    ' Configura a largura da linha como a largura util da pagina
    lnecab.X1 = 0
    lnecab.X2 = Relatorio.LarguraPapel - Relatorio.MargemDireita - Relatorio.MargemEsquerda
    lneRod.X1 = 0
    lneRod.X2 = Relatorio.LarguraPapel - Relatorio.MargemDireita - Relatorio.MargemEsquerda
End Sub

Private Sub Relatorio_IniciarSecao(ByVal Secao As ReportX.TSecao, ByVal Ordem As Byte)

    ' Ao iniciar o cab. de pagina, inicia o detalhe em branco
    If Secao = secCabecalho Then
        Det.BackColor = vbWhite
    End If
    
End Sub

Private Sub Rpx_MsgErro(Numero As Long)

    Dim Msg$
    
    If Numero < 0 Then
    
        ' Mensagens de erro previstas
        Select Case Numero - vbObjectError
            Case 1001: Msg = "é necessário existir uma impressora instalada no Windows"
            Case 1002: Msg = "Não há registros a imprimir"
            Case 1003: Msg = "Não foi definida a seção de detalhe do relatório"
            Case 1004: Msg = "A configuração das seções de grupos está incorreta"
            Case 1005: Msg = "Foi definido um cursor do tipo Forward-Only para o recordset do relatório."
            Case 1006: Msg = "A página configurada para o relatório não possuí espaço suficiente para a impressão"
            Case 1007: Msg = "Já existe um relatório em andamento"
        End Select
        
        MsgBox Msg, vbInformation, "Impressão"
        
    Else
        
        ' Mensagens não previstas. Isso pode significar um erro
        ' interno no ReportX. Se isso acontecer, por favor reporte isso
        ' através de e-mail para ser corrigido.
        MsgBox "Erro não previsto:" & Numero & vbCrLf & Error(Numero) & _
            IIf(Err.Number <> 0, vbCrLf + Err.Description, ""), vbCritical, "Impressão"
        
    End If
    
End Sub