Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
FORMATAR TEXTBOX
 
Notifications
Clear all

FORMATAR TEXTBOX

 
2024 - VBA & Macros
Post Recente por jonascruz 8 anos atrás
7 Posts
2 Usuários
0 Reactions
5,642 Visualizações
RSS
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

BOA NOITE

PRECISO DA AJUDA DE VOCÊS, QUERO FORMATAR OS TEXTBOX PARA DATA(DD/MM/AAAA), HORA(HH:MM), CPF(000.000.000-00), TELEFONE((XX) XXXX-XXXX)), MAS NÃO SEI FORMATAR, PODEM ME AJUDAR, COM O CÓDIGO DE CADA UM.

silva_jmp

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

 
Postado : 02/12/2011 6:09 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

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

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

Para CPF:

    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 exemplo utilizando CPF, tem outro tipo :
viewtopic.php?f=10&t=2780&p=12637&hilit=cpf#p12637

TextBox Fone para dois numeros formato : 2222-3344 / 3333-4567 :

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

Quanto a Horas, tem algumas formas, mas antes gostaria de saber se quer uma formatação simples, ou com verificação se é uma "Hora" valida, por exemplo, evitando digitar 25:20.
Vou ver onde deixei a rotina e mais tarde posto.

[]s

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

 
Postado : 02/12/2011 6:35 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Valeu Mauro, vou testar estas opções, caso poder me mande com verificação.

silva_jmp

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

 
Postado : 02/12/2011 6:43 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Mauro

Na formatação do fone teria como, ser (DD) XXXX-XXXX

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

 
Postado : 02/12/2011 6:48 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Silva, esqueci de comentar no inicio, da proxima vez favor não usar letras em maiusculo.
grato pela compreensão.

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

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

Faça os testes, as linhas desabilitadas, como pode observar, são para outros formatatos.

[]s

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

 
Postado : 02/12/2011 7:11 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Silva, segue as duas opções :

Textbox somente com um numero de Telefone e (dd), Formato (xx) xxxx-xxxx:

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:

    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

[]s

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

 
Postado : 02/12/2011 8:20 pm
 jonascruz
(@jonascruz)
Posts: 64
Trusted Member
 

Sobre esse código de formatar Data, eu gostaria que uma coluna (Range) e não no TextBox executasse essa macro.
Formato dd/mm/aa.
É possível adaptar?

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

Se a informação ou resposta foi útil, clique na mãozinha próxima ao botão "CITAR no canto superior direito.

Se o seu problema foi resolvido, clique no V verde para aceitar como resposta.

 
Postado : 25/08/2016 11:32 am
Forum Jump:
  Tópico Anterior
Próximo Tópico