VBA – Fomatar TextBox (Data, Telefone, CPF) nos Eventos KeyPress e Change

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" &amp; TextLength
			Case 2
				TimeStr = "00:" &amp; 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

Comentários

comentários