[Resolvido]Função em VBA para localizar determinado valor com condições

Bom dia!

Bd em Access 2010.

Objetos envolvidos:

Tabela: tbl_Produtos
Formulário: Produtos

Campos:
CODPRO: (Campo Chave, tipo número) - Nome do campo no Formulário: txtVarPro
ccNCM  (tipo texto) : campo composto por oito números. Ex: 64041900  - Nome do campo no Formulário: txtNCM
ccCEST (tipo texto): campo composto por sete números. Ex: 2805900 -  Nome do campo no Formulário: txtCEST


Gostaria de uma função em Vba que percorresse toda a tabela tbl_Produtos e quando localizasse produtos com a "ccNCM" iniciada com 64, fosse gravado naquele registro o ccCEST: 2805900.

A ideia é criar um botão de comando para executar a função.

Como posso resolver isso?

Desde já agradeço!

Olá Chamon,

Tente com estas duas funções:

Código:

Public Function Localizar ()
'Código de Eduardo Machado (Good Guy)
On Error Resume Next
Dim sCEST As Long
Dim rs As DAO.Recordset

Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_Produtos")

Do While Not rs.EOF
   If Not IsNull(UltimoCampoFormContinuo) Then
     DoCmd.RunCommandacCmdRecordsGoToNext

      If IsNull (OutroCampoChavedePreenchimento) Then
      Exit Do
      End If
Else
Exit Do
End If

Call AlterarCampo
Loop

Set rs = Nothing

End Function

Public Function AlterarCampo(nAlterar As Variant)
'Código de Eduardo Machado (Good Guy)
On Error Resume Next

Dim sCEST As String
Dim strSQL As String
          
        sCEST = "2805900"
       nAlterar = Me.ccNCM
          
       If Not IsNull(Me.ccNCM) And Left(nAlterar, 2) = 64 Then
          Me.ccCEST = sCEST
       End If
End Function


Código do botão que acionará essas funções:

Public Sub btnAcionar()

Call Localizar
End Sub


good guy,

obrigado pela ajuda, mas ainda não tivemos sucesso.

Tive dúvidas nas seguintes partes do código:

If Not IsNull(UltimoCampoFormContinuo) Then

If IsNull (OutroCampoChavedePreenchimento) Then


Segue anexo um exemplo com o teste.

Olá Chamon,

Vou baixar teu arquivo e depois reporto.

Olá Chamon,

Segue em anexo com a devida solução.

good guy, obrigado pelo retorno, funcionou quase perfeitamente. Apenas duas observações que não consegui corrigir:

1- Se o foco do cursor estiver no primeiro registro do formulário, e este tenha a NCM iniciada com 64, o CEST não está sendo salvo para este registro; ou ainda, digamos que por acaso o cursor esteja no terceiro item do formulário contínuo, sendo que este registro e os dois primeiros também tenham a NCM iniciada com 64, a função salva o CEST apenas a partir do próximo registro que a NCM inicie com 64, ficando os três primeiros sem o CEST.

Sendo assim, teria uma maneira de executar a função diretamente na tabela, sem percorrer o formulário?

2- Ao final do processo aparece a mensagem de erro em anexo:

Mais uma vez, agradeço pela atenção!

Olá Chamon,

Recue um pouco a chamada à função AlterarCampo e altere a mensagem de erro:

Código:


Public Function Localizar()
'Código de Eduardo Machado (Good Guy) - Técnicas Especiais de Access VBA - Ed. Ciência Moderna

          Dim sCEST As Long
          Dim rs As DAO.Recordset

10        On Error GoTo Localizar_Error

20        Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_Produtos")

          rs.MoveFirst           'Incluí um comando para retornar ao primeiro registro
          
          If Not IsNull(CODPROFOR) And Not rs.EOF Then
30        Do While Not rs.EOF
40            If Not IsNull(ccNCM) Then
                Call AlterarCampo(Me.ccNCM)
50                DoCmd.RunCommand acCmdRecordsGoToNext
                    
60                If IsNull(ccVarPro) Then


70                    Exit Do
80                End If
90            Else
100               Exit Do
              
110           End If

120
130       Loop
          rs.MoveLast
          
          
140       Set rs = Nothing
          
150       DoCmd.SetWarnings False

          
160       Else
170       Exit Function
          rs.Close
          
          End If
Localizar_Error:
MsgBox "Fim", vbInformation, "Alterações Concluídas"
180       'MsgBox "Ocorreu um erro na aplicação." & vbCr & "Relate os dados abaixo ao suporte." & vbCr & _
          '       "Erro Nº: " & Err.Number & vbCr & _
          '       "Descrição do Erro: " & Err.Description & vbCr & _
          '       "Módulo: " & "Form_ListaProdutos" & vbCr & _
          '       "Procedimento: " & "Localizar" & vbCr & _
          '       "Linha: " & Erl, vbExclamation, NomeAplicativo

End Function

Public Function AlterarCampo(nAlterar As Variant)
'Código de Eduardo Machado (Good Guy) - Técnicas Especiais de Access VBA - Ed. Ciência Moderna

10       On Error GoTo AlterarCampo_Error
          Dim sCEST As String
          Dim strSQL As String
                    
20        sCEST = "2805900"
30        nAlterar = Me.ccNCM
            
          
40        If Not IsNull(Me.ccNCM) And Left(nAlterar, 2) = 64 Then
            
50          Me.ccCEST = sCEST
          Else
          Exit Function
          
80        End If

90       On Error GoTo 0
100      Exit Function

AlterarCampo_Error:
MsgBox "Fim", vbInformation, "Alterações Concluídas"
110      ' MsgBox "Ocorreu um erro na aplicação." & vbCr & "Relate os dados abaixo ao suporte." & vbCr & _
         ' "Erro Nº: " & Err.Number & vbCr & _
         ' "Descrição do Erro: " & Err.Description & vbCr & _
         ' "Módulo: " & "Form_ListaProdutos" & vbCr & _
         ' "Procedimento: " & "AlterarCampo" & vbCr & _
         ' "Linha: " & Erl, vbExclamation, NomeAplicativo

End Function



good guy, obrigado funcionou em todos os registros, porém permaneceu a mensagem de erro.

Pensando em um sistema mais flexível para ajustar outros CESTs com NCMs diferentes, encontrei um código aqui no fórum e adaptei com partes do seu, o resultado ficou muito bom.

Acrescentei o campo "nAlterar" na consulta viewProdutos.

Criei o formulário "InserirCest"

Para testar:
abra o formulário ListaProdutos
clique no botão Inserir CEST
digite no campo NCM uma NCM nos quais os dois primeiros dígitos serão os números chave para inserir o CEST em todos os produtos, cuja NCM inicie com esses dígitos.
digite no campo CEST o número do CEST desejado para aquela NCM.
clicar no botão Inserir CEST
Sair

Em anexo está o arquivo funcionando para ajudar a outros integrantes do fórum que possam ter uma necessidade igual ou parecida.


No mais, muito obrigado pela colaboração.

Abraço e sucesso!

Olá Chamon,

Respeitados os devidos créditos no código, desejo sucesso para vocês. Minha sugestão é alterar a mensagem de erro por esta:

Código:


............
Localizar_Error:
MsgBox "Fim", vbInformation, "Alterações Concluídas"


Se quiser aprender mais adquira os meus dois livros DOMINE O ACCESS VBA e TÉCNICAS ESPECIAIS DE ACCESS VBA e você vai aprender isto e muito mais.

Editora Livrorama(DOMINE ...):
www.livrorama.com.br

Editora Ciência Moderna(TÉCNICAS...):
www.lcm.com.br


Um grande abraço.

"O temor do Senhor(respeito pela Palavra de Deus, leitura e obediência) é o princípio do conhecimento" (Prov. 1.7)
Disse Jesus: "E conhecereis a Verdade e a Verdade vos libertará". (Jo 8.32)
Disse Jesus: “Eu sou a luz do mundo; aquele que me segue, não andará em trevas, mas terá a luz da vida.” (Jo. 8.12)