inscreva-se
VBA!
Canal no Youtube criado por Amanda Nascimento
FORMATAÇÕES
* Formato moeda
Sub FORMATO_MOEDA(ByVal caixa As Control)
Dim valor As Variant, numPonto As Variant, numVirgula As Variant
Dim vlrp As Double, percent As Double
Dim y As Long
valor = caixa.Value
If IsNumeric(valor) Then
If InStr(1, valor, "-") >= 1 Then valor = Replace(valor, "-", "") 'retira sinal negativo
If InStr(1, valor, ",") >= 1 Then valor = CDbl(Replace(valor, ",", "")) 'retirar a virgula
If InStr(1, valor, ".") >= 1 Then valor = Replace(valor, ".", "") 'para trabalhar melhor retiramos ponto
Select Case Len(valor) 'verifica casas para inserção de ponto
Case 1
numPonto = "00" & valor
Case 2
numPonto = "0" & valor
Case 6 To 8
numPonto = Left(valor, Len(valor) - 5) & "." & Right(valor, 5)
Case 9 To 11
numPonto = inseriPonto(8, valor)
Case 12 To 14
numPonto = inseriPonto(11, valor)
Case Else
numPonto = valor
End Select
numVirgula = Left(numPonto, Len(numPonto) - 2) & "," & Right(numPonto, 2)
caixa.Value = numVirgula
End If
End Sub
-
Função Inserir Ponto
Function inseriPonto(inicio, valor)
Dim i As Variant, m1 As Variant, m2 As Variant, f As Variant
i = Left(valor, Len(valor) - inicio)
m1 = Left(Right(valor, inicio), 3)
m2 = Left(Right(valor, 8), 3)
f = Right(valor, 5)
If (m2 = m1) And (Len(valor) < 12) Then
inseriPonto = i & "." & m1 & "." & f
Else
inseriPonto = i & "." & m1 & "." & m2 & "." & f
End If
End Function
-
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
-
Formata Telefone
1. TextBox Fone para dois números 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
2. 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
3. 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
-
Formata Horas
Comm validação se a Hora é valida:
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