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 |
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 |
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 |
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 |
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 |
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 |
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