Notifications

Clear all

Código VBA textbox - placa de carro

2024 - VBA & Macros

Post Recente por Fernando Fernandes 8 anos atrás

8 Posts

4 Usuários

0 Reactions

2,051 Visualizações

RSS

meujovem

(@meujovem)

Posts: 47

Eminent Member

Topic starter

Prezados bom dia!!!
Estou com o código abaixo, mas gostaria de criar algumas condições

Modelo: JKV-3588 (Gostaria que não pudesse digitar mais de quatro números)
E também que no lugar das letra se digitasse números desse erro, e também teria que ser digitado exatamente tres letras

'Início placa de Carro 1
Private Sub txt_placa1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Len(txt_placa1.Text) <= 3 Then
txt_placa1.Text = UCase(txt_placa1.Text)
End If
If Len(txt_placa1) = 3 Then
txt_placa1.Text = txt_placa1 + "-"
End If
End Sub
'Fim placa de Carro 1

Antecipadamente fico muito grato

Wilson

Postado : 12/06/2017 9:22 am

Wagner Morel

(@wagner-morel-vidal-nobre)

Posts: 0

Illustrious Member

meujovem,

Boa tarde!

Creio que a maneira mais fácil de resolver esse problema é você dividir o recebimento da informação em duas partes: uma só para as letras e outra só para os números. Veja, no exemplo anexo, que fiz dessa forma.

Placa de carro.zip

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

Postado : 12/06/2017 12:46 pm

Fernando Fernandes

(@fernandofernandes)

Posts: 43750

Illustrious Member

Boa tarde,

Segue mais uma sugestão:

Private Sub txt_placa1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If Len(Me.txt_placa1.Value) < 3 Then
        If Not (KeyAscii >= 65 And KeyAscii <= 90 Or KeyAscii >= 97 And KeyAscii <= 122 Or KeyAscii = 8) Then
           KeyAscii = 0
        End If
    Else
        If Not (KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 8) Then
           KeyAscii = 0
        End If
    End If
    If Len(Me.txt_placa1.Value) = 4 Then
        Me.txt_placa1.Value = Mid(Me.txt_placa1, 1, 3) & "-" & Right(Me.txt_placa1.Value, 1)
    End If
End Sub

Private Sub txt_placa1_Change()
    Me.txt_placa1.Value = UCase(Me.txt_placa1.Value)
End Sub

Qualquer coisa da o grito.
Abraço

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 12/06/2017 1:33 pm

meujovem

(@meujovem)

Posts: 47

Eminent Member

Topic starter

Wagner

Gostei da ajuda...
Funcionou muito bem

Muito grato

Postado : 12/06/2017 5:01 pm

meujovem

(@meujovem)

Posts: 47

Eminent Member

Topic starter

Bernardo
Tambem funcionou perfeitamente,
Vou analisar cada uma para ver o que fica melhor pra mim

Muito grato pela ajuda

Postado : 12/06/2017 5:03 pm

Syrax

(@syrax)

Posts: 160

Estimable Member

meujovem,

Veja se isso te ajuda,

Fiz usando regex também

Private Sub txt_placa1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Dim reg, match
Set reg = CreateObject("VBScript.Regexp")
reg.Pattern = "(w{3}-d{4})"
reg.IgnoreCase = True
match = reg.test(txt_placa1.Text)
 If match = True Then
 txt_placa1.Text = UCase(reg.Execute(txt_placa1.Text).Item(0))
 Else
 ' mensagem de erro
 End If
End Sub

Se essa resposta te ajudou e resolveu o seu problema, clique no "joinha" ao lado de citar, e não esqueça de colocar o tópico como resolvido, clicando no ✓

Postado : 12/06/2017 7:27 pm

Syrax

(@syrax)

Posts: 160

Estimable Member

Só corrigindo a minha publicação, pois não da pra editar
o correto seria

reg.Pattern = "([a-z]{3}-d{4})"

Já que w permite todas as letras e números

meujovem,

Veja se isso te ajuda,

Fiz usando regex também

Private Sub txt_placa1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Dim reg, match
Set reg = CreateObject("VBScript.Regexp")
reg.Pattern = "(w{3}-d{4})"
reg.IgnoreCase = True
match = reg.test(txt_placa1.Text)
 If match = True Then
 txt_placa1.Text = UCase(reg.Execute(txt_placa1.Text).Item(0))
 Else
 ' mensagem de erro
 End If
End Sub

Se essa resposta te ajudou e resolveu o seu problema, clique no "joinha" ao lado de citar, e não esqueça de colocar o tópico como resolvido, clicando no ✓

Postado : 13/06/2017 10:24 am