Publicado 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 :
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:
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/viewtopic.php?f=10&t=2780&p=12637&hilit=cpf#p12637
Foramata Numeros de Fones : 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 |
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 |
Formata 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 |
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.
Link para o tópico do Fórum:
http://tomasvasquez.com.br/forum/viewtopic.php?f=17&t=1505&p=7213#p7213