MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    [Resolvido]Totais (linhas e colunas) em um relatório baseado em consulta de referencia cruzada

    avatar
    JSommavilla
    Intermediário
    Intermediário

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 66
    Registrado : 21/09/2014

    [Resolvido]Totais (linhas e colunas) em um relatório baseado em consulta de referencia cruzada Empty [Resolvido]Totais (linhas e colunas) em um relatório baseado em consulta de referencia cruzada

    Mensagem  JSommavilla 21/11/2015, 02:00

    Prezados, gostaria de uma ajuda:

    Estou iniciando no access e estou apanhando com esse problema, há dias. Já pesquisei muito aqui no fórum e na net. Encontrei um código para relatório baseado em consulta de referencia cruzada. O problema é que com o código que aí está, ele consegue mostrar os dados no relatório, porém ainda não consegui desvendar três problemas:

    1- No rodapé do relatório, não sai o total das colunas, aparecem zeros;

    2- Nas linhas do relatório, no detalhe, não sai o total das linhas, aparecem em branco;

    3- Ele repete, somente o último registro, 6 (seis) vezes no final do relatório.

    Não consegui desvendar onde está o erro. Se puderem me ajudar a encontrar, segue abaixo o código completo desse relatório:


    Option Compare Database 'Usa ordem do banco de dados em comparações de seqüências.
    Option Explicit

    'Constante para o número máximo de colunas que a consulta
    'poderá retornar

    Const conTotalDeColunas = 13

    'Variáveis para os objetos Database e Recordset.
    Dim MeuMDB As DAO.Database
    Dim rst As DAO.Recordset


    'Variáveis para o número de colunas do relatório.
    Dim intContagemDeColunas As Integer
    Dim SomaColunas() As Variant
    Dim TotalLinha As Variant

    Private Sub InitVars()

    Dim intX As Integer

    ' Initialize lngReportTotal variable.
    TotalLinha = 0

    ' Initialize array that stores column totals.
    For intX = 1 To conTotalDeColunas
    SomaColunas(intX) = 0
    Next intX

    End Sub


    Private Function xtabCnulls(varX As Variant)

    ' Test if a value is null.
    If IsNull(varX) Then
    ' If varX is null, set varX to 0.
    xtabCnulls = 0
    Else
    ' Otherwise, return varX.
    xtabCnulls = varX
    End If

    End Function
    Private Sub Detail_Retreat()

    ' Always back up to previous record when "Detail" section retreats.
    rst.MovePrevious

    End Sub



    Private Sub CabeçalhoBalancete_Format(Cancel As Integer, FormatCount As Integer)

    Dim intX As Integer
    ' Colo na títulos de coluna em caixas de texto no cabeçalho da página.
    For intX = 1 To intContagemDeColunas
    Me("Cab" & intX) = rst(intX - 1).Name
    Next intX
    Me("Cab" & intContagemDeColunas + 1) = "Total"
    'Oculta as caixas de texto não usadas no cabeçalho da página.
    For intX = (intContagemDeColunas + 2) To conTotalDeColunas
    Me("Cab" & intX).Visible = False
    Next intX


    End Sub

    Private Sub CabeçalhoDoRelatório_Format(Cancel As Integer, FormatCount As Integer)
    ' Move to first record in recordset at the beginning of the report
    ' or when the report is restarted. (A report is restarted when
    ' you print a report from Print Preview window, or when you return
    ' to a previous page while previewing.)
    rst.MoveFirst

    'Initialize variables.
    InitVars
    End Sub

    Private Sub Detalhe_Format(Cancel As Integer, FormatCount As Integer)

    'Coloca valores em caixas de texto e oculta as caixas de texto não usadas.

    Dim intX As Integer
    ' Verifica se não está no final de um conjunto de registros
    If Not rst.EOF Then
    'Se FormatCount é 1, coloca valores do conjunto de registros em caixas
    'de texto na seção detalhe.
    If Me.FormatCount = 1 Then

    For intX = 1 To intContagemDeColunas
    Me("Col" + Format(intX)) = xtabCnulls(rst(intX - 1))

    Next intX

    ' Oculta caixas de texto na seção detalhe.
    For intX = intContagemDeColunas + 2 To conTotalDeColunas
    Me("Col" + Format(intX)).Visible = False
    Next intX
    End If
    ' Vai para o próximo registro do conjunto de registros.
    rst.MoveNext

    End If
    End Sub

    Private Sub Report_Close()
    On Error Resume Next
    'Fecha o conjunto de registros.
    rst.Close
    Set MeuMDB = Nothing
    End Sub


    Private Sub Report_Open(Cancel As Integer)
    DoCmd.Maximize
    'Cria conjunto de registros base para o relatório usando critérios
    'inseridos no formulário RelatoriodeResultado.
    Dim intX As Integer
    Dim qdf As QueryDef
    Dim frm As Form
    'Não abre o relatório se o formulário RelatoriodeResultado
    'não está carregado.
    If Not (EstáCarregado("RelatoriosdeResultado")) Then
    Cancel = True
    MsgBox "Para visualizar ou imprimir este relatório, você precisa abrir " _
    & "Relatórios de Resultado em modo Formulário.", vbExclamation, _
    "É Preciso Abrir a Caixa de Diálogo"
    Exit Sub
    End If
    ' Define variável de banco de dados para o banco de dados atual.
    Set MeuMDB = CurrentDb
    Set frm = Forms![RelatoriosdeResultado]
    ' Abre objeto QueryDef.
    Set qdf = MeuMDB.QueryDefs("ResultadoconsolidadoTeste")
    ' Define parâmetros para a consulta com base nos valores inseridos
    ' no formulário FRM IniFim.
    qdf.Parameters("[Formulários]![RelatoriosdeResultado]![mesini]") = frm!mesini
    qdf.Parameters("[Formulários]![RelatoriosdeResultado]![mesfim]") = frm!mesfim
    qdf.Parameters("[Formulários]![RelatoriosdeResultado]![anoini]") = frm!anoini
    qdf.Parameters("[Formulários]![RelatoriosdeResultado]![anofim]") = frm!anofim
    qdf.Parameters("[Formulários]![RelatoriosdeResultado]![empresa]") = frm!Empresa
    ' Abre objeto Recordset.
    Set rst = qdf.OpenRecordset()
    'Define uma variável para armazenar o número de colunas de uma consulta
    'tabela de referência cruzada.
    intContagemDeColunas = rst.Fields.Count
    If intContagemDeColunas >= conTotalDeColunas Then
    intContagemDeColunas = conTotalDeColunas - 1
    End If
    ReDim SomaColunas(conTotalDeColunas + 1)

    End Sub

    Private Sub RodapéDoRelatório_Format(Cancel As Integer, FormatCount As Integer)

    Dim intX As Integer
    TotalLinha = 0

    For intX = 4 To intContagemDeColunas
    Me("Tot" & intX) = SomaColunas(intX)
    TotalLinha = TotalLinha + SomaColunas(intX)
    Next intX
    Me("Tot" & intContagemDeColunas + 1) = TotalLinha

    'Oculta as caixas de texto não usadas no cabeçalho da página.
    For intX = (intContagemDeColunas + 2) To conTotalDeColunas
    Me("Tot" + Format(intX)).Visible = False
    Next intX
    End Sub


    Agradeço muitíssimo por uma luz!
    avatar
    JSommavilla
    Intermediário
    Intermediário

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 66
    Registrado : 21/09/2014

    [Resolvido]Totais (linhas e colunas) em um relatório baseado em consulta de referencia cruzada Empty codigo corrigido

    Mensagem  JSommavilla 21/11/2015, 13:27

    Pessoal,

    Fiz um estudo mais aprofundado e consegui resolver todos os problemas do relatório. Porém, na soma do total de linhas e colunas, o resultado está em numero inteiro, com o valor decimal em zeros (00), quando o correto seria ter os valores decimais. Creio que é um caso de configuração. Vou continuar os estudos para achar esse erro. No mais, abaixo, segue código corrigindo os três erros apontados:

    Option Compare Database   'Usa ordem do banco de dados em comparações de seqüências.
    Option Explicit

    'Constante para o número máximo de colunas que a consulta
    'poderá retornar

    Const conTotalDeColunas = 13

    'Variáveis para os objetos Database e Recordset.
    Dim MeuMDB As DAO.Database
    Dim rst As DAO.Recordset


    'Variáveis para o número de colunas  do relatório.
    Dim intContagemDeColunas As Integer
    Dim SomaColunas(1 To conTotalDeColunas) As Long
    Dim TotalLinha As Long

    Private Sub InitVars()
         
      Dim intX As Integer

      ' Initialize lngReportTotal variable.
      TotalLinha = 0
       
      ' Initialize array that stores column totals.
      For intX = 1 To conTotalDeColunas
         SomaColunas(intX) = 0
      Next intX

    End Sub


    Private Function xtabCnulls(varX As Variant)
       
      ' Test if a value is null.
      If IsNull(varX) Then
         ' If varX is null, set varX to 0.
         xtabCnulls = 0
      Else
         ' Otherwise, return varX.
         xtabCnulls = varX
      End If

    End Function

    Private Sub CabeçalhoBalancete_Format(Cancel As Integer, FormatCount As Integer)

       Dim intX As Integer
       '  Colo na títulos de coluna em caixas de texto no cabeçalho da página.
       For intX = 1 To intContagemDeColunas
           Me("Cab" & intX) = rst(intX - 1).Name
       Next intX
       Me("Cab" & intContagemDeColunas + 1) = "Total"
       'Oculta as caixas de texto não usadas no cabeçalho da página.
       For intX = (intContagemDeColunas + 2) To conTotalDeColunas
           Me("Cab" & intX).Visible = False
       Next intX
         
           
    End Sub

    Private Sub CabeçalhoDoRelatório_Format(Cancel As Integer, FormatCount As Integer)
      '  Move to first record in recordset at the beginning of the report
      '  or when the report is restarted. (A report is restarted when
      '  you print a report from Print Preview window, or when you return
      '  to a previous page while previewing.)
      rst.MoveFirst

      'Initialize variables.
      InitVars
    End Sub

    Private Sub Detalhe_Format(Cancel As Integer, FormatCount As Integer)

    'Coloca valores em caixas de texto e oculta as caixas de texto não usadas.

    Dim intX As Integer
    '  Verifica se não está no final de um conjunto de registros
       If Not rst.EOF Then
       'Se FormatCount é 1, coloca valores do conjunto de registros em caixas
       'de texto na seção detalhe.
           If Me.FormatCount = 1 Then
           
              For intX = 1 To intContagemDeColunas
                   Me("Col" + Format(intX)) = xtabCnulls(rst(intX - 1))
                               
              Next intX
                       
                 ' Oculta caixas de texto na seção detalhe.
                   For intX = intContagemDeColunas + 2 To conTotalDeColunas
                      Me("Col" + Format(intX)).Visible = False
                   Next intX
             
               ' Vai para o próximo registro do conjunto de registros.
               rst.MoveNext
            End If
       End If

    End Sub
    Private Sub Detalhe_Print(Cancel As Integer, PrintCount As Integer)

    Dim intX As Integer
      Dim lngRowTotal As Long

        'If PrintCount is 1, initialize rowTotal variable.
        'Add to column totals.
      If Me.PrintCount = 1 Then
         lngRowTotal = 0
           
         For intX = 4 To intContagemDeColunas
            '  Starting at column 2 (first text box with crosstab value),
            '  compute total for current row in the "Detail" section.
            lngRowTotal = lngRowTotal + Me("Col" + Format(intX))

            '  Add crosstab value to total for current column.
            SomaColunas(intX) = SomaColunas(intX) + Me("Col" + Format(intX))
         Next intX
           
         '  Put row total in text box in the "Detail" section.
         Me("Col" + Format(intContagemDeColunas + 1)) = lngRowTotal
         '  Add row total for current row to grand total.
         TotalLinha = TotalLinha + lngRowTotal
      End If
    End Sub

    Private Sub Detalhe_Retreat()
    ' Always back up to previous record when "Detail" section retreats.
      rst.MovePrevious

    End Sub

    Private Sub Report_Open(Cancel As Integer)
    DoCmd.Maximize
    'Cria conjunto de registros base para o relatório usando critérios
    'inseridos no formulário RelatoriodeResultado.
       Dim intX As Integer
       Dim qdf As QueryDef
       Dim frm As Form
    'Não abre o relatório se o formulário RelatoriodeResultado
    'não está carregado.
       If Not (EstáCarregado("RelatoriosdeResultado")) Then
           Cancel = True
           MsgBox "Para visualizar ou imprimir este relatório, você precisa abrir " _
           & "Relatórios de Resultado em modo Formulário.", vbExclamation, _
           "É Preciso Abrir a Caixa de Diálogo"
           Exit Sub
       End If
       '  Define variável de banco de dados para o banco de dados atual.
       Set MeuMDB = CurrentDb
       Set frm = Forms![RelatoriosdeResultado]
       '  Abre objeto QueryDef.
       Set qdf = MeuMDB.QueryDefs("ResultadoconsolidadoTeste")
       ' Define parâmetros para a consulta com base nos valores inseridos
       ' no formulário FRM IniFim.
      qdf.Parameters("[Formulários]![RelatoriosdeResultado]![mesini]") = frm!mesini
      qdf.Parameters("[Formulários]![RelatoriosdeResultado]![mesfim]") = frm!mesfim
      qdf.Parameters("[Formulários]![RelatoriosdeResultado]![anoini]") = frm!anoini
      qdf.Parameters("[Formulários]![RelatoriosdeResultado]![anofim]") = frm!anofim
      qdf.Parameters("[Formulários]![RelatoriosdeResultado]![empresa]") = frm!Empresa
       '  Abre objeto Recordset.
       Set rst = qdf.OpenRecordset()
    'Define uma variável para armazenar o número de colunas de uma consulta
    'tabela de referência cruzada.
       intContagemDeColunas = rst.Fields.Count
       
    End Sub

    Private Sub Report_Close()
    On Error Resume Next
    'Fecha o conjunto de registros.
       rst.Close
      ' Set MeuMDB = Nothing
    End Sub


    Private Sub Report_NoData(Cancel As Integer)

      MsgBox "Não há dados para listar.", vbExclamation, "Inexistencia de Dados"
      rst.Close
      Cancel = True

    End Sub

    Private Sub RodapéDoRelatório_Print(Cancel As Integer, PrintCount As Integer)

    Dim intX As Integer
         
       For intX = 4 To intContagemDeColunas
         
          Me("Tot" + Format(intX)) = SomaColunas(intX)
               
       Next intX
          Me("Tot" + Format(intContagemDeColunas + 1)) = TotalLinha
                   
            'Oculta as caixas de texto não usadas no cabeçalho da página.
       For intX = (intContagemDeColunas + 2) To conTotalDeColunas
           Me("Tot" + Format(intX)).Visible = False
       Next intX

    End Sub

      Data/hora atual: 17/4/2021, 19:24