MASCARA DE CNPJ

Private Sub MaskEdBox1_Change()
'Verifica se existe espaço vazio na máscara
If InStr(MaskEdBox1.Text, MaskEdBox1.PromptChar) = 0 Then
  'Pular para o próximo controle
  SendKeys "{TAB}"
End If
End Sub

Private Sub Text1_Change()
   If Trim(Len(Text1.Text)) = 2 Then
      Text1.Text = Left(Text1.Text, 2) & "."
      Text1.SelStart = 4
   ElseIf Trim(Len(Text1.Text)) = 6 Then
      Text1.Text = Left(Text1.Text, 6) & "."
      Text1.SelStart = Len(Text1.Text) + 1
   ElseIf Trim(Len(Text1.Text)) = 10 Then
      Text1.Text = Left(Text1.Text, 10) & "/"
      Text1.SelStart = Len(Text1.Text) + 1
   ElseIf Trim(Len(Text1.Text)) = 15 Then
      Text1.Text = Left(Text1.Text, 15) & "-"
      Text1.SelStart = Len(Text1.Text) + 1
   End If
End Sub

Private Sub Maskcpfcgc_LostFocus()
On Error GoTo Error_Hdl
   If Len(MaskCPFCGC.Text) > 0 Then
      Select Case Len(MaskCPFCGC.Text)
       Case Is = 11
         MaskCPFCGC.Mask = "###.###.###-##"
         If Not calculacpf(MaskCPFCGC.Text) Then
            MsgBox "CPF com DV incorreto !!!"
            MaskCPFCGC = ""
            MaskCPFCGC.Mask = "##############"
            MaskCPFCGC.SetFocus
        End If
     Case Is = 14
         MaskCPFCGC.Mask = "##.###.###/####-##"
         If Not ValidaCGC(MaskCPFCGC.Text) Then
            MsgBox "CGC com DV incorreto !!! "
            MaskCPFCGC.Text = ""
            MaskCPFCGC.Mask = "##############"
            MaskCPFCGC.SetFocus
         End If
      End Select
    End If
 Exit Sub
24: Exit Sub
Error_Hdl:
26: MsgBox Err.Number & " - " & Err.Description & " na linha: " & Erl & " - FRMCLIENTES"
27: Exit Sub
End Sub

Private Sub Maskcpfcgc_KeyPress(KeyAscii As Integer)
On Error GoTo Error_Hdl
  'se teclar enter envia um TAB
33:  If KeyAscii = 13 Then
34:     SendKeys "{TAB}"
35:     KeyAscii = 0
36:  End If
37: Exit Sub
Error_Hdl:
39: MsgBox Err.Number & " - " & Err.Description & " na linha: " & Erl & " - FRMCLIENTES"
40: Exit Sub
End Sub

Public Function ValidaCGC(CGC As String) As Boolean
On Error GoTo Error_Hdl
88: If CalculaCGC(Left(CGC, 12)) <> Mid(CGC, 13, 1) Then
89:   ValidaCGC = False
90:   Exit Function
91: End If

93: If CalculaCGC(Left(CGC, 13)) <> Mid(CGC, 14, 1) Then
94:   ValidaCGC = False
95:   Exit Function
96: End If

98: ValidaCGC = True

100: Exit Function
Error_Hdl:
102: MsgBox Err.Number & " - " & Err.Description & " na linha: " & Erl & " - FRMCLIENTES"
103: Exit Function
End Function

Function calculacpf(CPF As String) As Boolean
'Esta rotina foi adaptada da revista Fórum Access
On Error GoTo Err_CPF
Dim I As Integer        'utilizada nos FOR... NEXT
Dim strcampo As String  'armazena do CPF que será utilizada para o cálculo
Dim strCaracter As String   'armazena os dígitos do CPF da direita para a esquerda
Dim intNumero As Integer    'armazena o digito separado para cálculo (uma a um)
Dim intMais As Integer  'armazena o digito específico multiplicado pela sua base
Dim lngSoma As Long     'armazena a soma dos dígitos multiplicados pela sua base(intmais)
Dim dblDivisao As Double    'armazena a divisão dos dígitos * base por 11
Dim lngInteiro As Long  'armazena inteiro da divisão
Dim intResto As Integer     'armazena o resto
Dim intDig1 As Integer  'armazena o 1º digito verificador
Dim intDig2 As Integer  'armazena o 2º digito verificador
Dim strConf As String   'armazena o digito verificador

125: lngSoma = 0
126: intNumero = 0
127: intMais = 0
128: strcampo = Left(CPF, 9)

'Inicia cálculos do 1º dígito
131: For I = 2 To 10
132:    strCaracter = Right(strcampo, I - 1)
133:    intNumero = Left(strCaracter, 1)
134:    intMais = intNumero * I
135:    lngSoma = lngSoma + intMais
136: Next I
137: dblDivisao = lngSoma / 11

139: lngInteiro = Int(dblDivisao) * 11
140: intResto = lngSoma - lngInteiro
141: If intResto = 0 Or intResto = 1 Then
142:    intDig1 = 0
143: Else
144:    intDig1 = 11 - intResto
145: End If

147: strcampo = strcampo & intDig1 'concatena o CPF com o primeiro digito verificador
148: lngSoma = 0
149: intNumero = 0
150: intMais = 0
'Inicia cálculos do 2º dígito
152: For I = 2 To 11
153:    strCaracter = Right(strcampo, I - 1)
154:    intNumero = Left(strCaracter, 1)
155:    intMais = intNumero * I
156:    lngSoma = lngSoma + intMais
157: Next I
158: dblDivisao = lngSoma / 11
159: lngInteiro = Int(dblDivisao) * 11
160: intResto = lngSoma - lngInteiro
161: If intResto = 0 Or intResto = 1 Then
162:    intDig2 = 0
163: Else
164:    intDig2 = 11 - intResto
165: End If
166: strConf = intDig1 & intDig2
'Caso o CPF esteja errado dispara a mensagem
168: If strConf <> Right(CPF, 2) Then
169:    calculacpf = False
170: Else
171:    calculacpf = True
172: End If
173: Exit Function

Exit_CPF:
176:    Exit Function
Err_CPF:
178:    MsgBox Error$
179:    Resume Exit_CPF
End Function

Private Sub Text1_KeyPress(KeyAscii As Integer)
   Select Case KeyAscii
      Case 8       'Aceita o BACK SPACE
      Case 13: SendKeys "{TAB}"    'Emula o TAB
      Case 48 To 57
         If Text1.SelStart = 2 Then Text1.SelText = "."
         If Text1.SelStart = 6 Then Text1.SelText = "."
         If Text1.SelStart = 10 Then Text1.SelText = "/"
         If Text1.SelStart = 15 Then Text1.SelText = "-"
      Case Else: KeyAscii = 0     'Ignora os outros caracteres
   End Select
End Sub