[Resolvido]Loop em caixa texto do relatorio para retonar o Max e o Min

Amigos como aplicar corretamente um loop em um controle de um relatorio para me retornar o Max e o Min?

Grato pela ajuda..

hary,
Crie quatro variáveis, duas para armazenar min e máx mais duas para controlo se é o primeiro valor de min e máx
Em cada registo, verifique se deve actualizar o valor de min ou de máx, ou as duas (no primeiro registo)

Boa tarde Alexandre.. não sei se por estar ja com a cabeça cheia de tentar.. Não estou a perceber..
poderia me fazer um pequeno exemplo?

Pode ate ser em um recordset... Mas estou aplicando aqui e ta me dando Parametros esperados = 1

Sub Aplica()
Dim Db As DAO.Database
Dim Rs As DAO.Recordset
Dim ws As DAO.Workspace
Dim StrSql As String

Set ws = DBEngine.Workspaces(0)
Set Db = ws.OpenDatabase(CurrentProject.Path & "\GestaoPCP18.mdb", False, False, "MS Access;PWD=senha")

StrSql = "SELECT tabrecepcao.ID_Recepcao AS Num, tabgranjas.CpNomeGranja AS Granja," _
& "tabrecepcao.CpData AS [Data Rec], Format([CpData],'mmmm') AS Mês," _
& "Format([CpData],'ww') AS Semana, tabrecepcao.CpGuiaTransitoAnimal AS Guia," _
& "tabrecepcao.CpPlacaCaminhao AS Placa, tabrecepcao.CpNumeroTicketPesagem AS Ticket," _
& "tabrecepcao.CpSexo AS Sexo, tabrecepcao.CpTipo AS Tipo, tabrecepcao.CpQuantidadeRecebidaCabeca AS [Qtd Rec Cb]," _
& "tabrecepcao.CpQuantidadeRecebidaKg AS [Qtd Rec Kg], ([CpQuantidadeRecebidaKg])/([CpQuantidadeRecebidaCabeca]) AS PesoMedio," _
& "tabrecepcao.CpMortalidadeTransporteCabeca AS [Mort Cab], ([CpMortalidadeTransporteCabeca])*([PesoMedio]) AS [Mort Tpt Kg]," _
& "(([CpMortalidadeTransporteCabeca])/([CpQuantidadeRecebidaCabeca]))*100 AS [Mort Tpt %], tabrecepcao.CpCondenacaoTotalCabeca AS [Cond Cab]," _
& "([CpCondenacaoTotalCabeca])*([PesoMedio]) AS [Cond Kg], (([CpCondenacaoTotalCabeca])/([CpQuantidadeRecebidaCabeca]))*100 AS [Cond Total%]," _
& "([CpQuantidadeRecebidaCabeca])-([CpMortalidadeTransporteCabeca])-([CpCondenacaoTotalCabeca]) AS [Qtd Abt Cb]," _
& "([QuantidadeAvesAbatidasCabeca])*([PesoMedio]) AS [Qtd Abt Kg], tabrecepcao.CpHoraSaidaGranja AS [Saida Granja]," _
& "tabrecepcao.CpHoraChegadaEmpresa AS [Cheg Empresa], tabrecepcao.CpHoraInicioAbate AS [Inicio Abate]," _
& "tabrecepcao.CpHoraTerminoAbate AS [Fim Abate], (([CpQuantidadeAvesGaiola1])+([CpQuantidadeAvesGaiola2])+([CpQuantidadeAvesGaiola3])" _
& "+([CpQuantidadeAvesGaiola4])+([CpQuantidadeAvesGaiola5])+([CpQuantidadeAvesGaiola6])+([CpQuantidadeAvesGaiola7])" _
& "+([CpQuantidadeAvesGaiola8])+([CpQuantidadeAvesGaiola9])+([CpQuantidadeAvesGaiola10]))/10 AS [Media Gaiola]," _
& "tabrecepcao.CpQuantidadeAvesGaiola1 AS [Gaiola 1], tabrecepcao.CpQuantidadeAvesGaiola2 AS [Gaiola 2]," _
& "tabrecepcao.CpQuantidadeAvesGaiola3 AS [Gaiola 3], tabrecepcao.CpQuantidadeAvesGaiola4 AS [Gaiola 4]," _
& "tabrecepcao.CpQuantidadeAvesGaiola5 AS [Gaiola 5], tabrecepcao.CpQuantidadeAvesGaiola6 AS [Gaiola 6]," _
& "tabrecepcao.CpQuantidadeAvesGaiola7 AS [Gaiola 7], tabrecepcao.CpQuantidadeAvesGaiola8 AS [Gaiola 8]," _
& "tabrecepcao.CpQuantidadeAvesGaiola9 AS [Gaiola 9], tabrecepcao.CpQuantidadeAvesGaiola10 AS [Gaiola 10]" _
& " FROM tabgranjas LEFT JOIN tabrecepcao ON tabgranjas.ID_Granja = tabrecepcao.ID_Granja_Rel" _
& " WHERE tabrecepcao.ID_Recepcao Is Not Null ORDER BY tabrecepcao.CpData;"

Set Rs = Db.OpenRecordset(StrSql)

MsgBox DMax(Rs("PesoMedio"), "StrSql")

End Sub

Utilizo a mesma SQL para carregar um RecordSource de uma ListBox e não encontro este problema...

Oh Hary,
Qualquer dia tenho de lhe tirar a papa para que coma com faca e garfo.
Veja aqui http://dl.dropbox.com/u/24017093/MaximoAccess/HaryMinMax.rar
Abraço,

Não está a funcionar no meu...

Ele não é baseado em uma tabela... nem consulta externa...

Tem uma SQL na Fonte de registro...
Sera por isso?

Mudei para formatar... Parece que resolveu...
Farei mais alguns testes e retorno..

Saudações

Mudei de Ao pintar para ao Formatar da Secção detalhes.. Funcionou..

Grato...


**** Agora podes traduzir isto?

Qualquer dia tenho de lhe tirar o biberão para que coma com faca e garfo.


hehehehe

Pode ser,
Para utilizar o código que apresentou, será mais rápido e ocupar menos memória se o tornar mais enxuto.
Tem de agrupar pelos campos que não utilizem funções de agregação
No entanto, o ponto de partida será

Dim Rs As DAO.Recordset
Dim ws As DAO.Workspace
Dim StrSql As String

Set ws = DBEngine.Workspaces(0)
Set Db = ws.OpenDatabase(CurrentProject.Path & "\GestaoPCP18.mdb", False, False, "MS Access;PWD=senha")

StrSql = "SELECT max(tabrecepcao.ID_Recepcao), Min(tabrecepcao.ID_Recepcao),tabgranjas.CpNomeGranja AS Granja," _
& "tabrecepcao.CpData AS [Data Rec], Format([CpData],'mmmm') AS Mês," _
& "Format([CpData],'ww') AS Semana, tabrecepcao.CpGuiaTransitoAnimal AS Guia," _
& "tabrecepcao.CpPlacaCaminhao AS Placa, tabrecepcao.CpNumeroTicketPesagem AS Ticket," _
& "tabrecepcao.CpSexo AS Sexo, tabrecepcao.CpTipo AS Tipo, tabrecepcao.CpQuantidadeRecebidaCabeca AS [Qtd Rec Cb]," _
& "tabrecepcao.CpQuantidadeRecebidaKg AS [Qtd Rec Kg], ([CpQuantidadeRecebidaKg])/([CpQuantidadeRecebidaCabeca]) AS PesoMedio," _
& "tabrecepcao.CpMortalidadeTransporteCabeca AS [Mort Cab], ([CpMortalidadeTransporteCabeca])*([PesoMedio]) AS [Mort Tpt Kg]," _
& "(([CpMortalidadeTransporteCabeca])/([CpQuantidadeRecebidaCabeca]))*100 AS [Mort Tpt %], tabrecepcao.CpCondenacaoTotalCabeca AS [Cond Cab]," _
& "([CpCondenacaoTotalCabeca])*([PesoMedio]) AS [Cond Kg], (([CpCondenacaoTotalCabeca])/([CpQuantidadeRecebidaCabeca]))*100 AS [Cond Total%]," _
& "([CpQuantidadeRecebidaCabeca])-([CpMortalidadeTransporteCabeca])-([CpCondenacaoTotalCabeca]) AS [Qtd Abt Cb]," _
& "([QuantidadeAvesAbatidasCabeca])*([PesoMedio]) AS [Qtd Abt Kg], tabrecepcao.CpHoraSaidaGranja AS [Saida Granja]," _
& "tabrecepcao.CpHoraChegadaEmpresa AS [Cheg Empresa], tabrecepcao.CpHoraInicioAbate AS [Inicio Abate]," _
& "tabrecepcao.CpHoraTerminoAbate AS [Fim Abate], (([CpQuantidadeAvesGaiola1])+([CpQuantidadeAvesGaiola2])+([CpQuantidadeAvesGaiola3])" _
& "+([CpQuantidadeAvesGaiola4])+([CpQuantidadeAvesGaiola5])+([CpQuantidadeAvesGaiola6])+([CpQuantidadeAvesGaiola7])" _
& "+([CpQuantidadeAvesGaiola8])+([CpQuantidadeAvesGaiola9])+([CpQuantidadeAvesGaiola10]))/10 AS [Media Gaiola]," _
& "tabrecepcao.CpQuantidadeAvesGaiola1 AS [Gaiola 1], tabrecepcao.CpQuantidadeAvesGaiola2 AS [Gaiola 2]," _
& "tabrecepcao.CpQuantidadeAvesGaiola3 AS [Gaiola 3], tabrecepcao.CpQuantidadeAvesGaiola4 AS [Gaiola 4]," _
& "tabrecepcao.CpQuantidadeAvesGaiola5 AS [Gaiola 5], tabrecepcao.CpQuantidadeAvesGaiola6 AS [Gaiola 6]," _
& "tabrecepcao.CpQuantidadeAvesGaiola7 AS [Gaiola 7], tabrecepcao.CpQuantidadeAvesGaiola8 AS [Gaiola 8]," _
& "tabrecepcao.CpQuantidadeAvesGaiola9 AS [Gaiola 9], tabrecepcao.CpQuantidadeAvesGaiola10 AS [Gaiola 10]" _
& " FROM tabgranjas LEFT JOIN tabrecepcao ON tabgranjas.ID_Granja = tabrecepcao.ID_Granja_Rel" _
& " WHERE tabrecepcao.ID_Recepcao Is Not Null ORDER BY tabrecepcao.CpData GROUP BY CampoX,CampoY,CampoZ;"

Set Rs = Db.OpenRecordset(StrSql)

MsgBox "Mínimo: " & Rs(1) & "Máximo: " & Rs(0)

Sobre a expressão, foi para brincar consigo por achar que se trata de pergunta que o Hary já tem mais que conhecimento para resolver!
Mas, como dizem os gregos, "Às vezes Homero dormita"

Entendi... Mas estava a dar voltas em soluções... e em relatorios com relação a Detalhes.. Pintar e tal.. ainda não havia mexido muito...

Obrigado..

Codigo da Solução:


Option Compare Database
Private Minimo As Double, Maximo As Double, PrimeiroRegisto As Boolean

Private Sub Detalhe_Format(Cancel As Integer, FormatCount As Integer)
If PrimeiroRegisto Then
Minimo = PesoMedio: Maximo = PesoMedio
PrimeiroRegisto = False
ElseIf PesoMedio < Minimo Then
Minimo = PesoMedio
ElseIf PesoMedio > Maximo Then
Maximo = PesoMedio
End If
Me.txtMin = Format(Minimo, "#,##0.00")
Me.txtMax = Format(Maximo, "#,##0.00")
End Sub


Private Sub Report_Activate()
PrimeiroRegisto = True
End Sub

Àmigão aproveitando a deixa como o assunto é semelhante...

Para desvio padrão em uma coluna de listBox.. utilizei o código a seguir..
Como aplicá-lo no entando neste mesmo relatorio?


Private Function fncDesvio(N As Double) As Double
Dim k, j As Long, Seq As String, media As Double, soma As Double

If Me!lstConsulta.ListCount < 2 Then
Exit Function
End If
If Me!lstConsulta.ListCount = 2 Then
fncDesvio = Me!lstConsulta.Column(N, 1)
Exit Function
End If

For j = 1 To Me!lstConsulta.ListCount - 1: Seq = Seq & Me!lstConsulta.Column(N, j) & "~": Next
Seq = Left(Seq, Len(Seq) - 1)
k = Split(Seq, "~")
For j = 0 To UBound(k): soma = soma + k(j): Next
media = soma / (Me!lstConsulta.ListCount - 1)
soma = 0
For j = 0 To UBound(k): soma = soma + ((media - k(j)) ^ 2): Next
fncDesvio = Sqr(soma / (Me!lstConsulta.ListCount - 2))
End Function

Hary,
A função que criou ficou presa ao controlo caixa de listagem.
A minha opinião é que devia ter a função a aceitar valores de um array ou de uma tabela, mesmo que essa tabela fosse temporária para auxiliar apenas o cálculo da função

Eu havia criado uma para tabela...

Esta foi feita pelo Avelino...

A da tabela criada por mim:



Private Sub DesvPadrao()
Dim i

'para looping em listBox
For i = 1 To Me.lstConsulta.ListCount - 1
'Insiro o registro na tabela temporária
CurrentDb.Execute "INSERT INTO TMP(Valores) Values(""" & Me.lstConsulta.Column(12, i) & """);"
Next i
'---------------------------------------------------------
'Cálculo de desvio padrão
Dim dblX As Double
Dim dblY As Double

'Desvio Padrão
dblX = DStDev("[Valores]", "TMP")
Me.txtdesvpad = dblX
' Population estimate.
'dblY = DStDevP("[Valores]", "TMP")
'MsgBox dblY
'Aqui você elimina a tabela
CurrentDb.Execute "DELETE * FROM TMP"

End Sub

Como adptar ao Relatorio?

Estou tentando algo assim:



rivate Sub Detalhe_Format(Cancel As Integer, FormatCount As Integer)
If PrimeiroRegisto Then
Minimo = PesoMedio: Maximo = PesoMedio
PrimeiroRegisto = False
ElseIf PesoMedio < Minimo Then
Minimo = PesoMedio

'Insiro o registro na tabela temporária
CurrentDb.Execute "INSERT INTO TMP(Valores) Values(""" & Me.PesoMedio & """);"


ElseIf PesoMedio > Maximo Then
Maximo = PesoMedio
End If
Me.txtMin = Format(Minimo, "#,##0.00")
Me.txtMax = Format(Maximo, "#,##0.00")

If IsNull(DStDev("[Valores]", "TMP")) = True Then GoTo Continuar
dblX = DStDev("[Valores]", "TMP")

Continuar:
Me.txtdesvpad = dblX

'CurrentDb.Execute "DELETE * FROM TMP"


End Sub

Eu ate pensei em levar a caixa de listagem para o relatorio deixando-a oculta.. carregando-a juntamente com o mesmo..
E ralizar todas as operações atraves dela..
O mim o Max e o Desvio Padrão...

Amigo alexandre... Veja o que fiz..

Este relatório sempre será baseado nos resuultados de uma listBox no form.. Com filtro ou sem filtro...

Então criei o relatório, nele coloquei a mesma ListBox em oculto...
Botão no form para abrir o relatório..
E ao Abrir o relatório:

Private Sub Report_Open(Cancel As Integer)
Me.RecordSource = Forms!frmRecepcao.lstConsulta.RowSource
Me.lstConsulta.RowSource = Forms!frmRecepcao.lstConsulta.RowSource
End Sub


E no relatorio as funções que retornam o Mim e o Max bem como o desvio padrão da ListBox..

Ficou bom...

O que acha?

Acho que deve pensar se vai utilizar a função poucas vezes ou muitas.
Se forem poucas, não justificará agilizar e ficará assim; se forem muitas será aconselhável criar função como disse.
Estava-me a referir à função aceitar argumento(s), calcular e devolver o resultado. O(s) argumento(s) podia ser previsto para nome de tabela, cadeia SQL ou array.
Como disse, pense se justificará autonomizar a função.

A sua função para o Min e o Max funcionou perfeitamente... encontrei problema no Desvio padrão...
Criei a tabela e inseri o código no Ao formatar dos detalhes..
Mas não deu muito certo..


rivate Sub Detalhe_Format(Cancel As Integer, FormatCount As Integer)
If PrimeiroRegisto Then
Minimo = PesoMedio: Maximo = PesoMedio
PrimeiroRegisto = False
ElseIf PesoMedio < Minimo Then
Minimo = PesoMedio

'Insiro o registro na tabela temporária
CurrentDb.Execute "INSERT INTO TMP(Valores) Values(""" & Me.PesoMedio & """);"

ElseIf PesoMedio > Maximo Then
Maximo = PesoMedio
End If
Me.txtMin = Format(Minimo, "#,##0.00")
Me.txtMax = Format(Maximo, "#,##0.00")

If IsNull(DStDev("[Valores]", "TMP")) = True Then GoTo Continuar
dblX = DStDev("[Valores]", "TMP")

Continuar:
Me.txtdesvpad = dblX

'CurrentDb.Execute "DELETE * FROM TMP"


A questão é justamente atualizar a tabela percorrendo o controle do relatorio.. que é apenas um, mas com dados do registro correspondente...

Olá amigos

Hary, segue exemplo do amigo Alexandre, modificado.

Baixar exemplo

Se quiser testar o DESVIO usando a tabela, use o código no evento "ao imprimir" do RODAPÉ.

Sucesso!

estou a trabalhar e também terei que rever a definição de desvio padrão.
Primeiro, responda às questões:
Justifica criar função independente?
Se sim, que argumento pretende utilizar: nome de tabela, texto SQL ou array?

Hary,
Peço-lhe desculpa, e aos restantes colegas do fórum, pelo termo que utilizei ontem. De facto, nem a expressão que utilizei é a usada comummente. Foi erro de escrever "ao correr da pena" e pelo adiantado da hora.
Concerteza que me desculpará e compreenderá que foi uma hora menos boa.
Abraço,

Tranquilo Amigão.. Nem percebi isso... Para mim esta tudo normal por aqui.. não percebi nada demais...

Fiquei preocupado que pudesse ser mal interpretado, mas tudo ultrapassado.
Já pensou como pretende a função (por tabela, por instrução SQL, ou por array)?

Deixe-me explicar a utilização disto para que me aconselhe qual a melhor solução..

é um relatorio de recepção de aves em um abatedouro...

Lança a todos os dados da carga recebida da Granja..
Total de Aves..
Peso da carga
Sexo
Tipo
hora de chegada
hora de saida.. entre outros dados..

Tenho o form onde cadastro estas informações... Tenho campos calculados, de onde se extrai entre outros

Peso Médio ( que é a soma do peso dos registros / pela qtd registro)
Media de abatimento por Cabeça, Kilo,,, porcentagens etc....

No form em um ctlGuia tenho a 2 Aba com a listBox baseado nos dados da tabela bem como adicionado os campos não acoplados de cauculos...

Esta listBox eu tenho filtros nela, por data Ini/Fim, Placa, TipoAve e granja...
Ao abrir o form ela abre com todos os dados da tabela recepção...Caso o usuário queira ver registros específicos filtrados por data, ou placa, ou granja... o faz selecionado o valor a ser filtrado e ao click de um botão... portanto a listBox exibira os registros devidamente filtrados... e o relatorio devera abrir justamente com a informação filtrada constante da listBox... e apresentando os mesmo calculos contidos no form.. que é para campo Peso médio, o Min o Max e o desvioPadrão...


Esta é a logica de utilização dessa soluçào...

Como eu fiz... coloquei a mesma list do form em oculto no relatorio.. e abro o relatorio carregado com o RowSource da lista e apliquei a lista no relatorio justamente porque o calculo do desvio padrao eu o consigo fazer na lista mas não o consegui no relatorio sem uso da list...


Espero que tenha compreendido..

Saudações

Caros Amigos Alexandre e Avelino, cumprimentando pela excelente ajuda..

Utilizando a solução de ambos de forma conjugada... e carregando o relatorio com o RowSoucer da listBox do Formulário (que é a informação a ser a apresentada no relatório)

Código:

Option Compare Database
Private Minimo As Double, Maximo As Double
Private strseq As String, j As Long

Private Sub Detalhe_Print(Cancel As Integer, PrintCount As Integer)
j = j + 1
If j = 1 Then
    Minimo = Me!PesoMedio
    Maximo = Me!PesoMedio
End If
If PesoMedio < Minimo Then Minimo = Me!PesoMedio
If PesoMedio > Maximo Then Maximo = Me!PesoMedio
strseq = strseq & Me!PesoMedio & "~"
End Sub

Private Sub RodapéDoRelatório_Print(Cancel As Integer, PrintCount As Integer)
Me.txtdesvpad = fncDesvio(strseq)
Me.txtMin = Format(Minimo, "#,##0.00")
Me.txtMax = Format(Maximo, "#,##0.00")
j = 0: Minimo = 0: Maximo = 0: strseq = ""
End Sub

Private Function fncDesvio(seq As String) As Double
Dim k, p As Long, media As Double, soma As Double
seq = Left(seq, Len(seq) - 1)
k = Split(seq, "~")
For p = 0 To UBound(k): soma = soma + k(p): Next
media = soma / j
soma = 0
For p = 0 To UBound(k): soma = soma + ((media - k(p)) ^ 2): Next
fncDesvio = Sqr(soma / (j - 1))
End Function


Private Sub Report_Close()
 Forms!frmRecepcao.Visible = True
End Sub

Private Sub Report_Open(Cancel As Integer)
Me.RecordSource = Forms!frmRecepcao.lstConsulta.RowSource
End Sub


Muito Obrigado!

Hary,
Pelo que apresenta, será melhor ter argumento array.
Nunca fiz, mas sempre se poderá batalhar até conseguir.
Daqui a pouco, volto ao trabalho exterior e logo regressarei.

Ainda não tenho conhecimentos suficientes com Array.. mas sempre é hora para aprender..

Saudações...

Bom dia Avenlino... Uma questão sobre o Desvio padrão no relatório...
>>> Se o abrir com apenas 1 registro dá erro 6 (Estouro)

Como fazer?

Grato

Ponha no inicio da função

Private Function fncDesvio(seq As String) As Double
Dim k, p As Long, media As Double, soma As Double
if j = 0 then exit function
if j = 1 then
fncDesvio = me!pesoMedio
exit function
end if
seq = Left(seq, Len(seq) - 1)
...


Sucesso!

Obrigado Amigão.. Tenha uma ótima noite..