MaximoAccess

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

Obrigado

Administração do MaximoAccess

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

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

    Compartilhe

    Chamon Consultoria
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 196
    Registrado : 31/08/2012

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

    Mensagem  Chamon Consultoria em Qua 5 Jul 2017 - 15:30

    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!
    avatar
    good guy
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1043
    Registrado : 05/02/2010

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

    Mensagem  good guy em Qua 5 Jul 2017 - 18:43

    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


    Última edição por good guy em Qui 6 Jul 2017 - 17:34, editado 2 vez(es)

    Chamon Consultoria
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 196
    Registrado : 31/08/2012

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

    Mensagem  Chamon Consultoria em Qui 6 Jul 2017 - 1:00

    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.
    Anexos
    INSERIR CEST.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (66 Kb) Baixado 6 vez(es)
    avatar
    good guy
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1043
    Registrado : 05/02/2010

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

    Mensagem  good guy em Qui 6 Jul 2017 - 13:36

    Olá Chamon,

    Vou baixar teu arquivo e depois reporto.


    Última edição por good guy em Qui 6 Jul 2017 - 17:35, editado 1 vez(es)
    avatar
    good guy
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1043
    Registrado : 05/02/2010

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

    Mensagem  good guy em Qui 6 Jul 2017 - 17:29

    Olá Chamon,

    Segue em anexo com a devida solução.
    Anexos
    INSERIR CEST.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (112 Kb) Baixado 8 vez(es)

    Chamon Consultoria
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 196
    Registrado : 31/08/2012

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

    Mensagem  Chamon Consultoria em Sex 7 Jul 2017 - 2:23

    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!
    Anexos
    ERRO CEST.png
    Você não tem permissão para fazer download dos arquivos anexados.
    (8 Kb) Baixado 1 vez(es)
    avatar
    good guy
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1043
    Registrado : 05/02/2010

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

    Mensagem  good guy em Sex 7 Jul 2017 - 13:33

    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

    Anexos
    INSERIR CEST-1.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (89 Kb) Baixado 5 vez(es)

    Chamon Consultoria
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 196
    Registrado : 31/08/2012

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

    Mensagem  Chamon Consultoria em Sex 7 Jul 2017 - 14:52

    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!
    Anexos
    INSERIR CEST original.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (79 Kb) Baixado 12 vez(es)
    avatar
    good guy
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1043
    Registrado : 05/02/2010

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

    Mensagem  good guy em Sex 7 Jul 2017 - 15:05

    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"


      Data/hora atual: Ter 21 Nov 2017 - 10:12