[Resolvido]Dúvida Docmd.close

Galera, boa tarde

Acredito que possam me ajudar nesse erro que estou tendo no meu formulário:

1. Preciso que o formulário seja finalizado sempre que o mesmo atingir o número máximo de análises efetuadas, estou utilizando o seguinte código evento Form_current():

Código:

Private Sub Form_Current()
Dim i, iMax As Long 'i é o contador e iMax é o máximo de análises permitido
Dim A, B, C, MT As Double
Dim strCNT, strINS, strCLS, strSQL, strUPD, strSEL As String
'------------------------------------------------------------------------------------------------------------------------------
'Verificando quantos registros foram digitados para essa análise
strCNT = "SELECT Count(tbl_regdeganalisesi.analista) AS contagem " & _
         "FROM tbl_regdeganalisesi " & _
         "GROUP BY tbl_regdeganalisesi.nrlote, tbl_regdeganalisesi.lotesq, tbl_regdeganalisesi.analista, tbl_regdeganalisesi.nrordem " & _
         "HAVING (((tbl_regdeganalisesi.nrlote)=" & Me.nrlote & ") AND ((tbl_regdeganalisesi.lotesq)=" & Me.lotesq & ") AND ((tbl_regdeganalisesi.nrordem)=" & Me.nrordem & "));"


Set db = CurrentDb
Set rs = db.OpenRecordset(strCNT)

i = 0
    
Do While Not rs.EOF
    
    i = i + 1
    
    rs.MoveNext

Loop

'Verificando qual o número máximo de análises possíveis
iMax = Nz(DCount("[cod_degustador]", "tbl_cfg_degustadores", "[dias]=" & Me.txtDias & " AND [ativo]=true"), 0)
'------------------------------------------------------------------------------------------------------------------------------
If i = iMax Then

    MsgBox "Não é possível digitar mais análises para esse registro." & vbNewLine + vbNewLine & _
           "Atualizando registros." & vbNewLine + vbNewLine & "Por favor FECHE esse formulário."
          
    'Limpo as análises da tabela tbl_ctqparcfganalises, deixando disponível para próxima avaliação
    strCLS = "UPDATE tbl_ctqparcfganalises SET nota='', observacao='' " & _
             "WHERE nota is not null;"
    
    DoCmd.RunSQL strCLS
    
    '-----------------------------------------------------------------------------------------
    
    'Soma as notas com tipo de Análise = A
    A = DSum("[nota]", "tbl_regdeganalisesi", "[nrlote]=" & Me.nrlote & " AND [lotesq]=" & Me.lotesq & " AND [nrordem]=" & Me.nrordem & " AND [dianls]=" & Me.dianls & " AND [tpanalise]='A'")
    
    'Soma as notas com tipo de Análise = B
    B = DSum("[nota]", "tbl_regdeganalisesi", "[nrlote]=" & Me.nrlote & " AND [lotesq]=" & Me.lotesq & " AND [nrordem]=" & Me.nrordem & " AND [dianls]=" & Me.dianls & " AND [tpanalise]='B'")
    
    'Soma as notas com tipo de Análise = C
    C = DSum("[nota]", "tbl_regdeganalisesi", "[nrlote]=" & Me.nrlote & " AND [lotesq]=" & Me.lotesq & " AND [nrordem]=" & Me.nrordem & " AND [dianls]=" & Me.dianls & " AND [tpanalise]='C'")
    
    'Calcula a média da soma de A + B - C e divide pelo número de análises efetuadas
    MT = (A + B - C) / i
    
    'atualizo o status da tabela tbl_regdeganalisesc
    strUPD = "UPDATE tbl_regdeganalisesc SET dtrealizada='" & Date & "', hrealizada='" & Time() & "', status =9, notafinal=" & Replace(MT, ",", ".") & " " & _
             "WHERE nrlote=" & Me.nrlote & " AND lotesq=" & Me.lotesq & " AND dianls=" & Me.dianls & " AND nrordem=" & Me.nrordem & ";"
    
    DoCmd.RunSQL strUPD
    
    '-----------------------------------------------------------------------------------------
          
    Forms![FRM_CTQManApontar_Filtro].Recalc
    
    DoCmd.Close
    
    '-----------------------------------------------------------------------------------------
End If

End Sub

Porém, quando executo o mesmo, apresenta erro em tempo de execução.

Sabem me dizer o que pode ser?

a condição para sair do formulário é quando o i = imax

Abs

Ola Kasa,

fiz algumas modificações e comentários no código. Segue:

Código:



Private Sub Form_Current()
Dim i, iMax As Long 'i é o contador e iMax é o máximo de análises permitido
Dim A, B, C, MT As Double
Dim strCNT, strINS, strCLS, strSQL, strUPD, strSEL As String
'------------------------------------------------------------------------------------------------------------------------------
'Verificando quantos registros foram digitados para essa análise
strCNT = "SELECT Count(tbl_regdeganalisesi.analista) AS contagem " & _
        "FROM tbl_regdeganalisesi " & _
        "GROUP BY tbl_regdeganalisesi.nrlote, tbl_regdeganalisesi.lotesq, tbl_regdeganalisesi.analista, tbl_regdeganalisesi.nrordem " & _
        "HAVING (((tbl_regdeganalisesi.nrlote)=" & Me.nrlote & ") AND ((tbl_regdeganalisesi.lotesq)=" & Me.lotesq & ") AND ((tbl_regdeganalisesi.nrordem)=" & Me.nrordem & "));"


Set db = CurrentDb
Set rs = db.OpenRecordset(strCNT)

i = 0

'-- Alexandre Fim ----------------------------------------------------------------------------------
'-- Neste caso, não há necessidade de criar um laço, pois já existe um COUNT no select
'Do While Not rs.EOF
'    i = i + 1
'    rs.MoveNext
'Loop

i = Nz(rs("contagem"), 0)
'---------------------------------------------------------------------------------------------------

'Verificando qual o número máximo de análises possíveis
iMax = Nz(DCount("[cod_degustador]", "tbl_cfg_degustadores", "[dias]=" & Me.txtDias & " AND [ativo]=true"), 0)
'------------------------------------------------------------------------------------------------------------------------------
If i = iMax Then

    MsgBox "Não é possível digitar mais análises para esse registro." & vbNewLine + vbNewLine & _
          "Atualizando registros." & vbNewLine + vbNewLine & "Por favor FECHE esse formulário."
         
    'Limpo as análises da tabela tbl_ctqparcfganalises, deixando disponível para próxima avaliação
    strCLS = "UPDATE tbl_ctqparcfganalises SET nota='', observacao='' " & _
            "WHERE nota is not null;"
   
    DoCmd.RunSQL strCLS
   
    '-----------------------------------------------------------------------------------------
   
    'Soma as notas com tipo de Análise = A
    A = DSum("[nota]", "tbl_regdeganalisesi", "[nrlote]=" & Me.nrlote & " AND [lotesq]=" & Me.lotesq & " AND [nrordem]=" & Me.nrordem & " AND [dianls]=" & Me.dianls & " AND [tpanalise]='A'")
   
    'Soma as notas com tipo de Análise = B
    B = DSum("[nota]", "tbl_regdeganalisesi", "[nrlote]=" & Me.nrlote & " AND [lotesq]=" & Me.lotesq & " AND [nrordem]=" & Me.nrordem & " AND [dianls]=" & Me.dianls & " AND [tpanalise]='B'")
   
    'Soma as notas com tipo de Análise = C
    C = DSum("[nota]", "tbl_regdeganalisesi", "[nrlote]=" & Me.nrlote & " AND [lotesq]=" & Me.lotesq & " AND [nrordem]=" & Me.nrordem & " AND [dianls]=" & Me.dianls & " AND [tpanalise]='C'")
   
    'Calcula a média da soma de A + B - C e divide pelo número de análises efetuadas
    MT = (A + B - C) / i
   
    'atualizo o status da tabela tbl_regdeganalisesc
    strUPD = "UPDATE tbl_regdeganalisesc SET dtrealizada='" & Date & "', hrealizada='" & Time() & "', status =9, notafinal=" & Replace(MT, ",", ".") & " " & _
            "WHERE nrlote=" & Me.nrlote & " AND lotesq=" & Me.lotesq & " AND dianls=" & Me.dianls & " AND nrordem=" & Me.nrordem & ";"
   
    DoCmd.RunSQL strUPD
   
    '-----------------------------------------------------------------------------------------
         
    Forms![FRM_CTQManApontar_Filtro].Recalc
   
    '-- Alexandre Fim
    '-- é necessário qual form deve fechar -----------
    'DoCmd.Close
    DoCmd.Close acForm, Me.Name
    '--------------------------------------------------
   
    '-----------------------------------------------------------------------------------------
End If

End Sub



Não testei as demais rotinas pois não temos a copia do bd, mas acredito que irá funcionar.

É isso

Att,
FIM

Obrigado @Avelino Sampaio pelas dicas, reformulei com base nas dicas que me passou, ficando assim o código agora:

Código:

Private Sub Form_Current()
Dim lngCnt As Long, lngMax As Long 'lngCnt é o contador e lngMax é o máximo de análises permitido
Dim dblA As Double, dblB As Double, dblC As Double, dblMT As Double 'dblA, dblB e dblC são as notas registradas para a análise e dblMT é a média total das análises
Dim strCNT As String, strCLS As String, strUPD As String
'------------------------------------------------------------------------------------------------------------------------------
'Verificando quantos registros foram digitados para essa análise
strCNT = "SELECT Count(tbl_regdeganalisesi.analista) AS contagem " & _
         "FROM tbl_regdeganalisesi " & _
         "GROUP BY tbl_regdeganalisesi.nrlote, tbl_regdeganalisesi.lotesq, tbl_regdeganalisesi.analista, tbl_regdeganalisesi.nrordem " & _
         "HAVING (((tbl_regdeganalisesi.nrlote)=" & Me.nrlote & ") AND ((tbl_regdeganalisesi.lotesq)=" & Me.lotesq & ") AND ((tbl_regdeganalisesi.nrordem)=" & Me.nrordem & "));"


Set db = CurrentDb
Set rs = db.OpenRecordset(strCNT)

lngCnt = 0

Do While Not rs.EOF

    lngCnt = lngCnt + 1

    rs.MoveNext

Loop


'Verificando qual o número máximo de análises possíveis
lngMax = Nz(DCount("[cod_degustador]", "tbl_cfg_degustadores", "[dias]=" & Me.txtDias & " AND [ativo]=true"), 0)

'------------------------------------------------------------------------------------------------------------------------------
If lngCnt = lngMax Then

    MsgBox "Não é possível digitar mais análises para esse registro." & vbNewLine + vbNewLine & _
           "Atualizando registros." & vbNewLine + vbNewLine & "Por favor FECHE esse formulário."
          
    'Limpo as análises da tabela tbl_ctqparcfganalises, deixando disponível para próxima avaliação
    strCLS = "UPDATE tbl_ctqparcfganalises SET nota='', observacao='' " & _
             "WHERE nota is not null;"
    
    DoCmd.RunSQL strCLS
    
    '-----------------------------------------------------------------------------------------
    
    'Soma as notas com tipo de Análise = A
    A = DSum("[nota]", "tbl_regdeganalisesi", "[nrlote]=" & Me.nrlote & " AND [lotesq]=" & Me.lotesq & " AND [nrordem]=" & Me.nrordem & " AND [dianls]=" & Me.dianls & " AND [tpanalise]='A'")
    
    'Soma as notas com tipo de Análise = B
    B = DSum("[nota]", "tbl_regdeganalisesi", "[nrlote]=" & Me.nrlote & " AND [lotesq]=" & Me.lotesq & " AND [nrordem]=" & Me.nrordem & " AND [dianls]=" & Me.dianls & " AND [tpanalise]='B'")
    
    'Soma as notas com tipo de Análise = C
    C = DSum("[nota]", "tbl_regdeganalisesi", "[nrlote]=" & Me.nrlote & " AND [lotesq]=" & Me.lotesq & " AND [nrordem]=" & Me.nrordem & " AND [dianls]=" & Me.dianls & " AND [tpanalise]='C'")
    
    'Calcula a média da soma de A + B - C e divide pelo número de análises efetuadas
    MT = (A + B - C) / lngCnt
    
    'atualizo o status da tabela tbl_regdeganalisesc
    strUPD = "UPDATE tbl_regdeganalisesc SET dtrealizada='" & Date & "', hrealizada='" & Time() & "', status =9, notafinal=" & Replace(MT, ",", ".") & " " & _
             "WHERE nrlote=" & Me.nrlote & " AND lotesq=" & Me.lotesq & " AND dianls=" & Me.dianls & " AND nrordem=" & Me.nrordem & ";"
    
    DoCmd.RunSQL strUPD
    
    '-----------------------------------------------------------------------------------------
          
    Forms![FRM_CTQManApontar_Filtro].Recalc
    
'    DoCmd.Close acForm, "FRM_CTQAvaliacaoSensorial_Dt"
    
    '-----------------------------------------------------------------------------------------
End If

End Sub

@Alexandre Fim, Obrigado por sua resposta, o erro persiste, porém, agora dá erro ao tentar executar o fechamento do formulário no evento Current() do mesmo, abaixo a mensagem de erro que aparece pra mim.




Outra coisa, eu tive que manter o laço no evento Current() pois da forma que vc comentou não executou.

Talvez tenha que ser em algum outro evento, mas o único que eu consegui fazer ler a quantidade de análises feitas e a quantidade vs as que ainda restam a serem executadas foi no Current() mesmo. Tem alguma outra sugestão?

Testei no botão cmdSalvar onClick(), mas ele sempre me dá o intCnt menor, ou seja, quando eu salvo a primeira vez, o resultado dele é 0, salvo novamente e me dá 1, mas era para ser 2.

Gente, boa tarde

alguma idéia a respeito?

@Kasa, separe os processos. Copie e cole o código abaixo:

Código:



Private Sub Form_Current()
   VerificaRegistros
End Sub

Private Sub VerificaRegistros()
Dim lngCnt As Long, lngMax As Long 'lngCnt é o contador e lngMax é o máximo de análises permitido
Dim dblA As Double, dblB As Double, dblC As Double, dblMT As Double 'dblA, dblB e dblC são as notas registradas para a análise e dblMT é a média total das análises
Dim strCNT As String, strCLS As String, strUPD As String
'------------------------------------------------------------------------------------------------------------------------------
'Verificando quantos registros foram digitados para essa análise
strCNT = "SELECT Count(tbl_regdeganalisesi.analista) AS contagem " & _
        "FROM tbl_regdeganalisesi " & _
        "GROUP BY tbl_regdeganalisesi.nrlote, tbl_regdeganalisesi.lotesq, tbl_regdeganalisesi.analista, tbl_regdeganalisesi.nrordem " & _
        "HAVING (((tbl_regdeganalisesi.nrlote)=" & Me.nrlote & ") AND ((tbl_regdeganalisesi.lotesq)=" & Me.lotesq & ") AND ((tbl_regdeganalisesi.nrordem)=" & Me.nrordem & "));"


Set db = CurrentDb
Set rs = db.OpenRecordset(strCNT)

lngCnt = 0

Do While Not rs.EOF

    lngCnt = lngCnt + 1

    rs.MoveNext

Loop


'Verificando qual o número máximo de análises possíveis
lngMax = Nz(DCount("[cod_degustador]", "tbl_cfg_degustadores", "[dias]=" & Me.txtDias & " AND [ativo]=true"), 0)

'------------------------------------------------------------------------------------------------------------------------------
If lngCnt = lngMax Then

    MsgBox "Não é possível digitar mais análises para esse registro." & vbNewLine + vbNewLine & _
          "Atualizando registros." & vbNewLine + vbNewLine & "Por favor FECHE esse formulário."
         
    'Limpo as análises da tabela tbl_ctqparcfganalises, deixando disponível para próxima avaliação
    strCLS = "UPDATE tbl_ctqparcfganalises SET nota='', observacao='' " & _
            "WHERE nota is not null;"
   
    DoCmd.RunSQL strCLS
   
    '-----------------------------------------------------------------------------------------
   
    'Soma as notas com tipo de Análise = A
    A = DSum("[nota]", "tbl_regdeganalisesi", "[nrlote]=" & Me.nrlote & " AND [lotesq]=" & Me.lotesq & " AND [nrordem]=" & Me.nrordem & " AND [dianls]=" & Me.dianls & " AND [tpanalise]='A'")
   
    'Soma as notas com tipo de Análise = B
    B = DSum("[nota]", "tbl_regdeganalisesi", "[nrlote]=" & Me.nrlote & " AND [lotesq]=" & Me.lotesq & " AND [nrordem]=" & Me.nrordem & " AND [dianls]=" & Me.dianls & " AND [tpanalise]='B'")
   
    'Soma as notas com tipo de Análise = C
    C = DSum("[nota]", "tbl_regdeganalisesi", "[nrlote]=" & Me.nrlote & " AND [lotesq]=" & Me.lotesq & " AND [nrordem]=" & Me.nrordem & " AND [dianls]=" & Me.dianls & " AND [tpanalise]='C'")
   
    'Calcula a média da soma de A + B - C e divide pelo número de análises efetuadas
    MT = (A + B - C) / lngCnt
   
    'atualizo o status da tabela tbl_regdeganalisesc
    strUPD = "UPDATE tbl_regdeganalisesc SET dtrealizada='" & Date & "', hrealizada='" & Time() & "', status =9, notafinal=" & Replace(MT, ",", ".") & " " & _
            "WHERE nrlote=" & Me.nrlote & " AND lotesq=" & Me.lotesq & " AND dianls=" & Me.dianls & " AND nrordem=" & Me.nrordem & ";"
   
    DoCmd.RunSQL strUPD
   
    '-----------------------------------------------------------------------------------------
         
    Forms![FRM_CTQManApontar_Filtro].Recalc
   
'    DoCmd.Close acForm, "FRM_CTQAvaliacaoSensorial_Dt"
   
    '-----------------------------------------------------------------------------------------
End If

End Sub



Acredito que irá funcionar.

Att,
FIM

@Alexandre Fim,

Fiz conforme orientou, mas o erro persiste, veja abaixo.

@Avelino, boa tarde

Testei as duas e não funcionou, em anexo o bando de dados para análise.

Abs

Qual formulário que apresenta o erro?

Ops...já localizei !!!

Antes de abrir o "FRM_CTQAvaliacaoSensorial_Dt", o sistema pede alguns parâmetros.
Nos informe para carregar o formulário com os dados.

Att,
FIM

Ok, @Avelino...eu tmb ajustei o intervalo para 1000.
Ops...tem um formulário para filtragem...não percebi...fui direto no código...
Obrigado, mestre !


Att,
Fim

@Kasa,
Fiz alguns ajustes no código, pois havia um equivoco na query que fazia contagem de registros.
A rotina fazia um laço (While) na quantidade de linhas da query.
OBS: verifique os comentário que fiz, para ajudar a elucidar.

Segue versão ajustada

É isso

Att,
FIM

Boa tarde,

Me desculpem a ignorância, mas não está fuincionando comigo.

O formulário deverá fechar sempre que for detectado que o número de análises realizadas forem iguais ao número de análises efetuadas. No caso a rotina funcionou quando ao final eu tenho que pressionar uma última vez o botão [SALVAR], ai ele aparece a mensagem de encerramento, atualiza as tabelas e encerra o formulário, mas isso deve ser executado depois que eu fizer o salvamento da última análise, por esse motivo eu havia colocado no event Current() do formulário, para que a contagem após ele retornar para o formulário pudesse encerrar o mesmo.

Alguma idéia onde posso modificar?

Você pode colocar essa rotina de validação de análises na tela de pesquisa, antes de abrir o formulário.

Bom dia @Alexandre,

Eu estou fazendo essa verificação no filtro, antes da abertura do formulário, mas o formulário quando é aberto em uma análise cujo status seja = "0 - Em aberto" deixa fazer um número determinado de análises e é nesse momento que eu quero finalizar o formulário. O digitador vai preenchendo por analista o resultado e quando atinge o número máximo de análises permitidas ele deveria finalizar o formulário em aberto.

No método Current() foi o único que eu consegui calcular em tempo de execução com maior exatidão o número de análises realizadas vs o número de análises máximas permitidas.

Abs

Galera, boa tarde

estou dando o tópico por resolvido, decidi deixar o formulário aberto e sem que apareça o nome do avaliador, portanto, se o usuário tentar salvar esse registro sem o avaliador ele já executa a rotina de fechamento do formulário.

Foi a única coisa que consegui fazer.

Abs a todos e obrigado