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

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!

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