|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Validações)
|
|
 |
Título da Dica: Validar CPF e CNPJ, com Máscara !!!
|
 |
|
|
|
Postada em 28/12/2001 por RODRIGO
activexnanet@bol.com.br
'Em um Modulo.bas
Public Formato, Numeros As String
Function Fu_consistir_CgcCpf(Vl_CgcCpf As String)
' Esta Rotina Devolverá True Se o Cgc/Cpf Informado For valido
' ou False Se o Cgc/Cpf Não For Correto
Fu_consistir_CgcCpf = False
Dim VA_CgcCpf As String
Dim VA_Digito As String
Static Numero(15) As Integer
Dim VA_Resto As Integer
Dim VA_Resultado As Integer
Dim VA_SomaDigito10 As Integer
Dim VA_resto1 As Integer
VA_CgcCpf = Format(SóNumeros(Vl_CgcCpf), "@@@@@@@@@@@@@@")
VA_Digito = Mid(VA_CgcCpf, 13, 2)
'frmCritica_CPCCGC.LblVerificador.Caption = VA_Digito
Numero(1) = Val(Mid(VA_CgcCpf, 1, 1))
Numero(2) = Val(Mid(VA_CgcCpf, 2, 1))
Numero(3) = Val(Mid(VA_CgcCpf, 3, 1))
Numero(4) = Val(Mid(VA_CgcCpf, 4, 1))
Numero(5) = Val(Mid(VA_CgcCpf, 5, 1))
Numero(6) = Val(Mid(VA_CgcCpf, 6, 1))
Numero(7) = Val(Mid(VA_CgcCpf, 7, 1))
Numero(8) = Val(Mid(VA_CgcCpf, 8, 1))
Numero(9) = Val(Mid(VA_CgcCpf, 9, 1))
Numero(10) = Val(Mid(VA_CgcCpf, 10, 1))
Numero(11) = Val(Mid(VA_CgcCpf, 11, 1))
Numero(12) = Val(Mid(VA_CgcCpf, 12, 1))
Numero(13) = Val(Mid(VA_CgcCpf, 13, 1))
Numero(14) = Val(Mid(VA_CgcCpf, 14, 1))
If Len(Trim(VA_CgcCpf)) > 11 Then ' Cgc
Formato = Format(Numeros, "@@.@@@.@@@/@@@@-@@")
VA_Resultado = (Numero(1) * 5) + (Numero(2) * 4) _
+ (Numero(3) * 3) + (Numero(4) * 2) _
+ (Numero(5) * 9) + (Numero(6) * 8) + _
(Numero(7) * 7) + (Numero(8) * 6) + _
(Numero(9) * 5) + (Numero(10) * 4) + _
(Numero(11) * 3) + (Numero(12) * 2)
' Atribui para resto o resto da divisão
' de VA_resultado dividido por 11
VA_Resto = VA_Resultado Mod 11
If VA_Resto < 2 Then
VA_resto1 = 0
Else
VA_resto1 = 11 - VA_Resto
End If
If VA_resto1 <> Numero(13) Then
Exit Function
End If
VA_Resultado = (Numero(1) * 6) + _
(Numero(2) * 5) + (Numero(3) * 4) + _
(Numero(4) * 3) + (Numero(5) * 2) + _
(Numero(6) * 9) + (Numero(7) * 8) + _
(Numero(8) * 7) + (Numero(9) * 6) + _
(Numero(10) * 5) + (Numero(11) * 4) + _
(Numero(12) * 3) + (Numero(13) * 2)
' Atribui para resto o resto da divisão
' de VA_resultado dividido por 11
VA_Resto = VA_Resultado Mod 11
If VA_Resto < 2 Then
VA_resto1 = 0
Else
VA_resto1 = 11 - VA_Resto
End If
If VA_resto1 <> Numero(14) Then
Exit Function
End If
Else ' Cpf
Formato = Format(Numeros, "@@@.@@@.@@@ - @@")
VA_Resultado = (Numero(4) * 1) + (Numero(5) * 2) _
+ (Numero(6) * 3) + (Numero(7) * 4) _
+ (Numero(8) * 5) + (Numero(9) * 6) _
+ (Numero(10) * 7) + (Numero(11) * 8) + (Numero(12) * 9)
VA_Resto = VA_Resultado Mod 11
If VA_Resto > 9 Then
VA_resto1 = VA_Resto - 10
Else
VA_resto1 = VA_Resto
End If
'frmCritica_CPCCGC.LblC1.Caption = VA_resto1
If VA_resto1 <> Numero(13) Then
GoTo Sairr
End If
VA_Resultado = (Numero(5) * 1) _
+ (Numero(6) * 2) + (Numero(7) * 3) _
+ (Numero(8) * 4) + (Numero(9) * 5) + _
(Numero(10) * 6) + (Numero(11) * 7) + _
(Numero(12) * 8) + (VA_resto1 * 9)
VA_Resto = VA_Resultado Mod 11
If VA_Resto > 9 Then
VA_resto1 = VA_Resto - 10
Else
VA_resto1 = VA_Resto
End If
'frmCritica_CPCCGC.LblC2.Caption = VA_resto1
If VA_resto1 <> Numero(14) Then
Exit Function
End If
End If
Fu_consistir_CgcCpf = True
Exit Function
Sairr:
VA_Resultado = (Numero(5) * 1) _
+ (Numero(6) * 2) + (Numero(7) * 3) _
+ (Numero(8) * 4) + (Numero(9) * 5) + _
(Numero(10) * 6) + (Numero(11) * 7) + _
(Numero(12) * 8) + (VA_resto1 * 9)
VA_Resto = VA_Resultado Mod 11
If VA_Resto > 9 Then
VA_resto1 = VA_Resto - 10
Else
VA_resto1 = VA_Resto
End If
'frmCritica_CPCCGC.LblC2.Caption = VA_resto1
If VA_resto1 <> Numero(14) Then
Exit Function
End If
End Function
Function SóNumeros(x As String) As String
On Error Resume Next
Dim temp As String
Dim j As Integer
temp = ""
For j = 1 To Len(x)
If Mid(x, j, 1) = "0" Or _
Mid(x, j, 1) = "1" Or _
Mid(x, j, 1) = "2" Or _
Mid(x, j, 1) = "3" Or _
Mid(x, j, 1) = "4" Or _
Mid(x, j, 1) = "5" Or _
Mid(x, j, 1) = "6" Or _
Mid(x, j, 1) = "7" Or _
Mid(x, j, 1) = "8" Or _
Mid(x, j, 1) = "9" Then
temp = temp + Mid(x, j, 1)
End If
Next
Numeros = temp
SóNumeros = temp
End Function
'Para Chamar a Funcao !
'If Fu_consistir_CgcCpf(MskCPF) = False Then
' MsgBox "Cpf Informado não é valido", 64
' TxtCPF.SetFocus
' Exit Sub
'Else
' MskCPF.Text = Formato
'End If
'End Sub
'Utilizo em meus sistemas essa rotina e funciona muito bem :)
'Até Mais
|
|
|
|
|
