Formatação de campos e outros eventos Excel VBA

Formatando campo Data

No exemplo abaixo o campo que vai receber a data é txt_data

Private Sub txt_data_Exit(ByVal Cancel AsMSForms.ReturnBoolean)

If len(txt_data) = 2 then
   txt_data.text = txt_data.text + "/"
End if

If len(txt_data) = 5 then
   txt_data.text = txt_data.text + "/"
End if

End Sub

Outra forma opcional

Private Sub txt_data_Exit(ByVal Cancel AsMSForms.ReturnBoolean)

CampoData = Format(CampoData, "dd,mm d yyyy")

End Sub

Chamar um aplicativo externo

'No exemplo abaixo estamos chamando o aplicativo calculadora.exe que se encontra na pasta Boleto na unidade padrão C:\

Sub calculadora()
    Dim ReturnValue
    ReturnValue = Shell("C:\Boleto\calculadora\calculadora.exe", 1)
    AppActivate ReturnValue
End Sub


Formatação de números com 3 dígitos

Private Sub txt_qt_Exit(ByVal Cancel As MSForms.ReturnBoolean)

exemplo1 = Format(exemplo1, "000")

End Sub

Formatação de telefone

Private Sub txt_telfixo_Exit(ByVal Cancel As MSForms.ReturnBoolean)

telefone = Format(telefone, "(00) 0000-0000")

End Sub

Formatando números decimais

Private Sub txt_val_Exit(ByVal Cancel As MSForms.ReturnBoolean)

exemplo2 = Format(exemplo2, "##,##0.00")

End Sub


Máscara de Texto para CPF

Private Sub txt_cpf_KeyPress (ByVal KeyAscii As MSForms.ReturnInteger)


txt_cpf.MaxLength = 14 '032.656.054-71
Select Case KeyAscii
Caso 8 'Aceita o espaço traseiro
Caso 13: SendKeys "{TAB}" 'Emula o TAB
Caso 48 a 57
Se txt_cpf.SelStart = 3 Em seguida, txt_cpf.SelText = "."
Se txt_cpf.SelStart = 7 Então txt_cpf.SelText = "."
Se txt_cpf.SelStart = 11 Então txt_cpf.SelText = "-"
Case Else: KeyAscii = 0 'IGNORA página Outros os Caracteres
End Select

End Sub

Outra Opção de CPF

Private Sub Cpf_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 8, 48 To 57
Me.cpf.MaxLength = 14 ' Quantidade máxima de caracteres no textbox Cpf

If Len(cpf) = 3 Then cpf = cpf + "."
If Len(cpf) = 7 Then cpf = cpf + "."
If Len(cpf) = 11 Then cpf = cpf + "-"
Case Else
KeyAscii = 0
End Select

End Sub

Formato do CNPJ:

Private Sub CNPJ_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 8, 48 To 57
Me.CNPJ.MaxLength = 18 ' Quantidade máxima de caracteres no textbox CNPJ If Len(CNPJ) = 2 Then CNPJ = CNPJ + "."
If Len(CNPJ) = 6 Then CNPJ = CNPJ + "."
If Len(CNPJ) = 10 Then CNPJ = CNPJ + "/"
If Len(CNPJ) = 15 Then CNPJ = CNPJ + "-"
Case Else
KeyAscii = 0
End Select 

 
End Sub

Formato de CPF com teste de validação

Public Function CPF(xCPF As String) As String
Dim d1 As Integer
Dim d2 As Integer
Dim d3 As Integer
Dim d4 As Integer
Dim d5 As Integer
Dim d6 As Integer
Dim d7 As Integer
Dim d8 As Integer
Dim d9 As Integer
Dim d10 As Integer
Dim d11 As Integer
Dim digito_1 As Integer
Dim digito_2 As Integer
Dim UltDig As Integer
Dim sxCPF As String

sxCPF = Right("00000000000" + Trim(xCPF), 11)
If Len(sxCPF) < 11 Then
    sxCPF = String(11 - Len(sxCPF), "0") & sxCPF
End If

UltDig = Len(sxCPF)

If sxCPF = "00000000000" Then
    CPF = ""
    Exit Function
End If

d1 = CInt(Mid(sxCPF, UltDig - 10, 1))
d2 = CInt(Mid(sxCPF, UltDig - 9, 1))
d3 = CInt(Mid(sxCPF, UltDig - 8, 1))
d4 = CInt(Mid(sxCPF, UltDig - 7, 1))
d5 = CInt(Mid(sxCPF, UltDig - 6, 1))
d6 = CInt(Mid(sxCPF, UltDig - 5, 1))
d7 = CInt(Mid(sxCPF, UltDig - 4, 1))
d8 = CInt(Mid(sxCPF, UltDig - 3, 1))
d9 = CInt(Mid(sxCPF, UltDig - 2, 1))
d10 = CInt(Mid(sxCPF, UltDig - 1, 1))
d11 = CInt(Mid(sxCPF, UltDig, 1))

digito_1 = d1 + (d2 * 2) + (d3 * 3) + (d4 * 4) + (d5 * 5) + (d6 * 6) + (d7 * 7) + (d8 * 8) + (d9 * 9)
digito_1 = digito_1 Mod 11

xdigito_1 = digito_1
If digito_1 = 10 Then
    xdigito_1 = 0
End If

digito_2 = d2 + (d3 * 2) + (d4 * 3) + (d5 * 4) + (d6 * 5) + (d7 * 6) + (d8 * 7) + (d9 * 8) + (xdigito_1 * 9)
digito_2 = digito_2 Mod 11

xdigito_2 = digito_2
If digito_2 = 10 Then
    xdigito_2 = 0
End If

If d10 = xdigito_1 And d11 = xdigito_2 Then
    CPF = "CPF Válido"
Else
    CPF = "CPF Inválido, Redigite"
End If


Ocultar Barra de Ferramentas no Excel

Sub Ocultar()

Dim barras
For Each barras In Application.CommandBars

barras.Enabled = False

Next
Application.DisplayFullScreen = True
ActiveWindow.DisplayHeadings = False
Application.DisplayFormulaBar = False
ActiveWindow.DisplayHorizontalScrollBar = True
ActiveWindow.DisplayVerticalScrollBar = False
ActiveWindow.DisplayWorkbookTabs = False


End Sub

Exibir barras no Excel

Sub Reexibir()
Dim barras
Application.EnableCancelKey = xlDisabled
On Error Resume Next
For Each barras In Application.CommandBars

barras.Enabled = True

Next


Abrir o formulário boleto usando o evento auto_open na inicialização da planilha principal.

Sub auto_open()

Application.Visible = False
boleto.Show

End Sub


Fechar um formulário

Private Sub BTN_Sair_Click()
  Unload Me
End Sub


Botão confirmar uma senha pré-determinada no Excel VBA

Private Sub ENTER_Click()

If senha.Text <> "123" Then
MsgBox "A senha está incorreta, digite novamente"
Else
Unload Me
Application.Visible = True
Sheets("Nome da planilha").Visible = True
End If

End Sub