Notifications
Clear all

PEENCHIMENTO DE TXTBOX'S COM AFTERUPDATE SEM RETORNO

3 Posts
2 Usuários
0 Reactions
964 Visualizações
AMORIM123
(@amorim123)
Posts: 77
Trusted Member
Topic starter
 

E ai galera!

No cód do evento txt_periodo_AfterUpdate do meu "frm_rbpa" tenho a instrução para que quando digitada uma data ou selecionada uma data cujo registro já conste na sheets("Comum") os txtbox's: "txt_rpa" e "txt_fspa" sejam carregados com os demais dados do mesmo resgitro, se não houver semelhança então "txt_rpa" e "txt_fspa" = sem preenchimento

quando seleciono ocorre tudo legal: img_calendario_Click()

Private Sub img_calendario_Click()
    'abre o calendário
    txt_periodo.Value = GetCalendário
    'limpa os txtbox's
    txt_rpa = ""
    txt_fspa = ""
    'em seguida chama evento afterupdate para caso haja dados semelhantes os txtbox's
    'sejam carregados com os demais dados do registro
    Call txt_periodo_AfterUpdate
End Sub

Porém, quando seleciono o primeiro registro da sheets("Comum") (25/05/2018)ele roda legal, quanto seleciono o segundo registro (10/05/2018) ele não retorna o preenchimento dos "txt_rpa" e "txt_fspa" e se em seguida seleciono uma data para qual não há registros ai..acontece o que deveria: "txt_rpa" e "txt_fspa" = sem preenchimento

Private Sub txt_periodo_AfterUpdate()

Dim lngPriLin, lngUltLin, lngLoopLin       As Long
Dim datperiodo                             As Date
Dim strbusca                               As String
    
    lngPriLin = 2
    
With Me
    On Error GoTo trataErro
    datperiodo = .txt_periodo.Text
End With
    
With wshComum
    
    lngUltLin = .Cells(.Rows.Count, 2).End(xlUp).Row
        
    For lngLoopLin = lngPriLin To lngUltLin Step 1
            strbusca = .Cells(lngLoopLin, 2)
            'busca pela data semelhante
            If strbusca = datperiodo Then
              MsgBox ("Para o período " & datperiodo & " já há dados cadastrados, caso queira realizar uma pesquisa, selecione botão OK do formulário; se desejar editar os dados prossiga com as alterações nos campos desejados e selecione SALVAR, em seguida OK para seguir editando."), vbExclamation, aviso
                'carrega os dados da busca nos txt's em formato moeda
                'Me.txt_rpa.SetFocus
                'Format((Me.txt_rpa), "R$ #,###.00") = CCur(.Cells(lngLoopLin, 3))
                'Format((Me.txt_fspa), "R$ #,###.00") = CCur(.Cells(lngLoopLin, 4))
                Me.txt_rpa = Format(CCur(.Cells(lngLoopLin, 3)), "R$ #,###.00")
                Me.txt_fspa = Format(CCur(.Cells(lngLoopLin, 4)), "R$ #,###.00")
                Exit Sub
            'se minha strbusca for diferente do "txt_periodo" então os txtbox's são carregados
            'sem preenchimento, pois a data digitada em "txt_periodo" não tem registro na
            'sheets("Comum")
            ElseIf strbusca <> datperiodo Then
                Me.txt_rpa = ""
                Me.txt_fspa = ""
                Exit Sub
            Exit For
            End If
            
    Next lngLoopLin
        
End With
    
trataErro:
If Err.Number = 13 Then
    Me.txt_periodo = ""
    Me.txt_rpa = ""
    Me.txt_fspa = ""
End If

End Sub

Muito obrigado pela atenção e conhecimento!

Link da planilha anexa em dropbox:
https://www.dropbox.com/s/a1dtp7tv8eocq ... .xlsm?dl=0

Muito Obrigado pelo tempo e conhecimento!

 
Postado : 30/05/2018 5:22 am
fcarlosc
(@fcarlosc)
Posts: 453
Honorable Member
 

Boa-noite

Tente assim:


Private Sub txt_periodo_AfterUpdate()

Dim lngPriLin, lngUltLin, lngLoopLin       As Long
Dim datperiodo                             As Date
Dim strbusca                               As String
    
    lngPriLin = 2
    
With Me
    On Error GoTo trataErro
    datperiodo = .txt_periodo.Text
End With
    
With wshComum
    
    lngUltLin = .Cells(.Rows.Count, 2).End(xlUp).Row
        
    For lngLoopLin = lngPriLin To lngUltLin Step 1
            strbusca = .Cells(lngLoopLin, 2)
            'busca pela data semelhante
            If strbusca = datperiodo Then
              MsgBox ("Para o período " & datperiodo & " já há dados cadastrados, caso queira realizar uma pesquisa, selecione botão OK do formulário; se desejar editar os dados prossiga com as alterações nos campos desejados e selecione SALVAR, em seguida OK para seguir editando."), vbExclamation, aviso
                'carrega os dados da busca nos txt's em formato moeda
                'Me.txt_rpa.SetFocus
                'Format((Me.txt_rpa), "R$ #,###.00") = CCur(.Cells(lngLoopLin, 3))
                'Format((Me.txt_fspa), "R$ #,###.00") = CCur(.Cells(lngLoopLin, 4))
                Me.txt_rpa = Format(CCur(.Cells(lngLoopLin, 3)), "R$ #,###.00")
                Me.txt_fspa = Format(CCur(.Cells(lngLoopLin, 4)), "R$ #,###.00")
                Exit Sub
            'se minha strbusca for diferente do "txt_periodo" então os txtbox's são carregados
            'sem preenchimento, pois a data digitada em "txt_periodo" não tem registro na
            'sheets("Comum")
            Exit For
            
            Else
                
                Me.txt_rpa = ""
                Me.txt_fspa = ""
            
            End If
            
    Next lngLoopLin
        
End With
    
trataErro:
If Err.Number = 13 Then
    Me.txt_periodo = ""
    Me.txt_rpa = ""
    Me.txt_fspa = ""
End If

End Sub

 
Postado : 30/05/2018 6:13 pm
AMORIM123
(@amorim123)
Posts: 77
Trusted Member
Topic starter
 

fcarlos
cara. ...Curioso!

havia tentado dessa forma anteriormente também, porém estava colocando o "else" antes do "exit for"...

Muito obrigado!

 
Postado : 01/06/2018 5:03 am