Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Fomatar TextBox Eventos KeyPress e Change

Dicas dos mais variados tipos, necessidades, angústias, enfim
Avatar do usuário
Mauro Coutinho
Jedi
Jedi
Mensagens: 1561
Registrado em: Sáb Mar 13, 2010 8:10 pm
Localização: São José dos Pinhais - Pr

Fomatar TextBox Eventos KeyPress e Change

Mensagem por Mauro Coutinho »

Colegas, conforme solicitação em outro Forum, referente a alguns tipos de formatação em TextBox, segue as rotinas utilizando-se os Eventos KeyPress e Change :

Formata DATA : Supondo que o TextBox esteja com o nome "txtData", a formatação ocorrerá quando da digitação :

Código: Selecionar todos

    Private Sub txtData_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        'Limita a Qde de caracteres
        txtData.MaxLength = 8
       
        'para permitir que apenas números sejam digitados
        If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
            KeyAscii = 0
        End If
       
    End Sub

    Private Sub txtData_Change()
        'Formata : dd/mm/aa
        If Len(txtData) = 2 Or Len(txtData) = 5 Then
            txtData.Text = txtData.Text & "/"
            SendKeys "{End}", True
        End If
    End Sub
Formata CPF :

Código: Selecionar todos

        Private Sub Txt_CPF_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
            'Limita a Qde de caracteres
            Txt_CPF.MaxLength = 14

             Select Case KeyAscii
                Case 8, 48 To 57 ' BackSpace e numericos
                  If Len(Txt_CPF) = 3 Or Len(Txt_CPF) = 12 Then
                    Txt_CPF.Text = Txt_CPF.Text & "."
                    SendKeys "{End}", False
               
                ElseIf Len(Txt_CPF) = 7 Then
                    Txt_CPF.Text = Txt_CPF.Text & "."

                ElseIf Len(Txt_CPF) = 11 Then
                    Txt_CPF.Text = Txt_CPF.Text & "-"
                    SendKeys "{End}", False
                  End If
               
                Case Else ' o resto é travado
                    KeyAscii = 0
              End Select
        End Sub
Veja um exemplo utilizando CPF com verificação de Digito :
http://www.planilhando.com.br/forum/vie ... cpf#p12637

Foramata Numeros de Fones : TextBox Fone para dois numeros formato : 2222-3344 / 3333-4567 :

Código: Selecionar todos

    Private Sub txtFone_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
            'Limita a Qde de caracteres
            txtFone.MaxLength = 21     

             Select Case KeyAscii
            Case 8, 48 To 57 ' BackSpace e numericos
              If Len(txtFone) = 4 Or Len(txtFone) = 10 Then
                txtFone.Text = txtFone.Text & "-"
                SendKeys "{End}", False
           
            ElseIf Len(txtFone) = 9 Then
                txtFone.Text = txtFone.Text & " / "
           
            ElseIf Len(txtFone) = 16 Then 'Or Len(txtFone) = 20 Then
                txtFone.Text = txtFone.Text & "-"
                SendKeys "{End}", False
              End If
           
            Case Else ' o resto é travado
                KeyAscii = 0
          End Select

    End Sub
Formato Horas, com validação se a Hora é valida, não tenho a fonte, ja faz um tempo que usei esta rotina :

Código: Selecionar todos

    Private Sub txtHoras_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
        Dim TimeStr As String
       
        Set TextLength = txtHoras

        On Error GoTo EndMacro
        With txtHoras
            If HasFormula = False Then

            Select Case Len(TextLength)
           
                Case 1
                    TimeStr = "00:0" & TextLength
                Case 2
                    TimeStr = "00:" & TextLength
                Case 3
                    TimeStr = Left(TextLength, 1) & ":" & Right(TextLength, 2)
                Case 4
                    TimeStr = Left(TextLength, 2) & ":" & Right(TextLength, 2)
                   
                'Case 5 ' ex: 12345 = 01:23:45
                '        TimeStr = Left(TextLength, 1) & ":" & Mid(TextLength, 2, 2) & ":" & Right(TextLength, 2)
                'Case 6 ' ex: 123456 = 12:34:56
                '        TimeStr = Left(TextLength, 2) & ":" & Mid(TextLength, 3, 2) & ":" & Right(TextLength, 2)
               
                Case Else
                  MsgBox "HORA EM BRANCo !!!"
                          'With TextBox1
                          '    .SetFocus
                              '.SelStart = 0
                              '.SelLength = Len(.Text)
                        '  End With
                  Exit Sub
           
            End Select
                Application.EnableEvents = False
                Formula = TimeValue(TimeStr)
                txtHoras = TimeStr
                sCancel = False
            End If
        End With
       
        GoTo Fim
       
    EndMacro:
       
        MsgBox "HORA Inválida !!!"
              With txtHoras
               .SetFocus
               .SelStart = 0
               .SelLength = Len(.Text)
          End With
          sCancel = True
         
    Fim:
        Application.EnableEvents = True
    End Sub

    Private Sub txtHoras_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    'Limita a Qde de caracteres
        txtHoras.MaxLength = 4
       
        Select Case KeyAscii
                Case 8, 48 To 57 ' BackSpace e numericos
                  'If Len(txtHoras) = 2 Or Len(txtHoras) = 6 Then
                  '  txtHoras.Text = txtHoras.Text & ":"
                    SendKeys "{End}", False
                 ' End If
                Case Else ' o resto é travado
                    KeyAscii = 0
              End Select
    End Sub
Formata Textbox somente com um numero de Telefone e (dd), Formato (xx) xxxx-xxxx:

Código: Selecionar todos

    Private Sub txtFone_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        'Limita a Qde de caracteres
        txtFone.MaxLength = 14
       
        'Formato (xx) xxxx-xxxx
        If Len(txtFone) = 0 Then
            txtFone.Text = "("
        End If
       
        If Len(txtFone) = 3 Then
            txtFone.Text = txtFone & ") "
        End If
       
        If Len(txtFone) = 9 Then
            txtFone.Text = txtFone & "-"
        End If
       
    End Sub
Textbox com dois numeros de Telefone e (dd), Formato (xx) xxxx-xxxx / xxxx-xxxx:

Código: Selecionar todos

        Private Sub txt2Fone_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
                'Limita a Qde de caracteres
                txt2Fone.MaxLength = 26
               
                'Formato (xx) xxxx-xxxx / xxxx-xxxx
                If Len(txt2Fone) = 0 Then
                    txt2Fone.Text = "("
                End If
           
                If Len(txt2Fone) = 3 Then
                    txt2Fone.Text = txt2Fone & ") "
                End If

                Select Case KeyAscii
               
                     Case 8, 48 To 57 ' BackSpace e numericos
                       If Len(txt2Fone) = 9 Or Len(txt2Fone) = 10 Then
                         txt2Fone.Text = txt2Fone.Text & "-"
                         SendKeys "{End}", False
                   
                     ElseIf Len(txt2Fone) = 14 Then
                         txt2Fone.Text = txt2Fone.Text & " / "
                   
                     ElseIf Len(txt2Fone) = 21 Then
                         txt2Fone.Text = txt2Fone.Text & "-"
                         SendKeys "{End}", False
                       End If
                   
                     Case Else ' o resto é travado
                    KeyAscii = 0
                   
              End Select

        End Sub
Façam os testes, só não esqueçam de arrumarem os nomos dos controles Textbox conforme estão nas rotinas.

Quem tiver mais algumas rotinas interessantes e quiser postar fiquem a vontade.

[]s


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
Melo
Colaborador
Colaborador
Mensagens: 70
Registrado em: Ter Jan 12, 2010 4:26 pm

Re: Fomatar TextBox Eventos KeyPress e Change

Mensagem por Melo »

Fale Mauro blz irmão

Muito boa as Dicas



Mais . . ., este MAIS é perseguidor, em!, e para o CNPJ ? o Titio Mauro postou para Data, CPF, Horas e Telefones.

Amigos do Fórum não se preocupem o Titio Melo vai ajudar, é claro se o Titio Mauro permitir, mais (di novo esse MAIS) sei que ele vai.

Recentemente usei este em um trabalho

Código: Selecionar todos

Private Sub txtCnpj_Change()

txtCnpj.MaxLength = 18 " Limita a quantidade digitada no campo

' Ao digitar os Dois primeiros dígitos inseri Ponto
If Len(txtCnpj) = 2 Then
txtCnpj = txtCnpj + "."
txtCnpj.SelStart = 4
End If
' Ao digitar os Seis primeiros dígitos inseri Ponto
If Len(txtCnpj) = 6 Then
txtCnpj = txtCnpj + "."
txtCnpj.SelStart = 8
End If
' Ao digitar os Dez primeiros dígitos inseri um Barra
If Len(txtCnpj) = 10 Then
txtCnpj = txtCnpj + "/"
txtCnpj.SelStart = 12
End If

' Ao digitar os Quinze primeiros dígitos inseri o Traço
If Len(txtCnpj) = 15 Then
txtCnpj = txtCnpj + "-"
txtCnpj.SelStart = 17
End If
End Sub


Bem acho que é isso,

Mauro desculpe pela brincadeira

Um forte abraço

Dúvidas


wotan
Acabou de chegar
Acabou de chegar
Mensagens: 1
Registrado em: Dom Jan 08, 2012 9:21 pm

Re: Fomatar TextBox Eventos KeyPress e Change

Mensagem por wotan »

Chegando agora no fórum, mas se me permitem "intrometer" na conversa, abaixo coloco um código para formtação do CNPJ, seguindo o raciocínio da formatação do CPF passada pelo Mauro:

Formata CNPJ:

Código: Selecionar todos

Private Sub Txt_CNPJ_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    'Limita a Qde de caracteres
    Txt_CNPJ.MaxLength = 18
 
     Select Case KeyAscii
        Case 8, 48 To 57 ' BackSpace e numericos
          If Len(Txt_CNPJ) = 2 Or Len(Txt_CNPJ) = 6 Then
            Txt_CNPJ.Text = Txt_CNPJ.Text & "."
            SendKeys "{End}", False
 
        ElseIf Len(Txt_CNPJ) = 10 Then
            Txt_CNPJ.Text = Txt_CNPJ.Text & "/"
 
        ElseIf Len(Txt_CNPJ) = 15 Then
            Txt_CNPJ.Text = Txt_CNPJ.Text & "-"
            SendKeys "{End}", False
          End If
 
        Case Else ' o resto é travado
            KeyAscii = 0
      End Select
End Sub

Abs.
a todos!


Avatar do usuário
costaribeiro
Colaborador
Colaborador
Mensagens: 96
Registrado em: Ter Mar 04, 2014 10:10 am
Localização: Pouso Alegre - MG

Re: Fomatar TextBox Eventos KeyPress e Change

Mensagem por costaribeiro »

Sou um simpatizante do VBA.

Quanto à formatação do telefone, tem-se o formato habitual (dd) cccc-nnnn. Mas, se eu quiser colocar este formato e o novo formato (que acrescenta "9")? "(dd) 9cccc-nnnn". Ou seja, usar tanto um quanto outro na mesma textBox. Como ficaria o código? Abaixo está o formato habitual:
================================
Private Sub box_celular_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Limita a Qde de caracteres
box_celular.MaxLength = 14

'Formato (xx) xxxx-xxxx
If Len(box_celular) = 0 Then
box_celular.Text = "("
End If

If Len(box_celular) = 3 Then
box_celular.Text = box_celular & ") "
End If

If Len(box_celular) = 9 Then
box_celular.Text = box_celular & "-"
End If

End Sub


====================================================

Obrigado. :geek:


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
joseA
Jedi
Jedi
Mensagens: 1048
Registrado em: Qui Out 22, 2009 7:22 am
Localização: Cel. Fabriciano - MG

Re: Fomatar TextBox Eventos KeyPress e Change

Mensagem por joseA »

Bem vindo ao fórum.

Código: Selecionar todos

Private Sub box_celular_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Limita a Qde de caracteres
box_celular.MaxLength = 15

'Formato (xx) xxxx-xxxx
If Len(box_celular) = 0 Then
box_celular.Text = "("
End If

If Len(box_celular) = 3 Then
box_celular.Text = box_celular & ") 9"
End If

If Len(box_celular) = 10 Then
box_celular.Text = box_celular & "-"
End If

End Sub


Cesanio
Acabou de chegar
Acabou de chegar
Mensagens: 4
Registrado em: Seg Dez 15, 2014 12:37 pm

Re: Fomatar TextBox Eventos KeyPress e Change

Mensagem por Cesanio »

Olá,

Tentei usar a formula apresentada para data no meu projeto.

Mas, parece que não deu certo.

Poderia me ajudar?

Grato.
Anexos
Foto do aviso do erro.
Foto do aviso do erro.
EXCEL Erro.jpg (147.93 KiB) Exibido 26735 vezes


Avatar do usuário
Reinaldo
Jedi
Jedi
Mensagens: 1537
Registrado em: Sex Ago 01, 2014 4:09 pm
Localização: Garça - SP / SCS - SP

Re: Fomatar TextBox Eventos KeyPress e Change

Mensagem por Reinaldo »

Verifique a sintaxe da função
Na foto parece --> if len(txtData)-2 ou... deve ser sinal de igual não menos.
txtData.tex=txtdata.text & amp; --> Deve ser txtData.tex=txtdata.text & "/"


Cesanio
Acabou de chegar
Acabou de chegar
Mensagens: 4
Registrado em: Seg Dez 15, 2014 12:37 pm

Re: Fomatar TextBox Eventos KeyPress e Change

Mensagem por Cesanio »

Oi,
Fiz as modificações sugeridas.

Mas, o erro passou para o outro código anterior, conforme a foto anexa. E tento preencher no frm, mas só fica as "/".
Anexos
EXCEL Erro1.jpg
EXCEL Erro1.jpg (157.29 KiB) Exibido 26727 vezes


Avatar do usuário
Reinaldo
Jedi
Jedi
Mensagens: 1537
Registrado em: Sex Ago 01, 2014 4:09 pm
Localização: Garça - SP / SCS - SP

Re: Fomatar TextBox Eventos KeyPress e Change

Mensagem por Reinaldo »

Muitas vezes no achômetro, conseguimos adivinhar o erro e propor soluções.
Assim fica muito dificil.
A linha que está selecionada em sua imagem postada, não está de acordo com o código proposto.
Veja a sintaxe no post original e o código com erro (Por exemplo: &alt; --> o que é de onde tirou)


Cesanio
Acabou de chegar
Acabou de chegar
Mensagens: 4
Registrado em: Seg Dez 15, 2014 12:37 pm

Re: Fomatar TextBox Eventos KeyPress e Change

Mensagem por Cesanio »

Oh...
Não sei como isso aconteceu.

O "<" aparece trocado por "&". Me desculpe. AGORA DEU CERTO.

Só queria saber, onde modifico para que aceite a data tipo: dd/mm/yyyy. Pois, já aumentei os caracteres mas a barra não fica no lugar certo.
E toda vez que inicio a digitação na txtData, mas quero usar a tecla "Backspace", não aceita deletar os números anteriores, isso é normal?

Valeu mesmo. Obg.


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder