---

Nesse artigo vou postar uma função pra validar CPF e CNPJ.
Vamos lá crie um módulo de código e coloque essa codificação:

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 digitos 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 digitos multiplicados pela sua base(intmais)
Dim dblDivisao As Double 'armazena a divisão dos digitos*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

lngSoma = 0
intNumero = 0
intMais = 0
strcampo = Left(CPF, 9)

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

lngInteiro = Int(dblDivisao) * 11
intResto = lngSoma - lngInteiro
If intResto = 0 Or intResto = 1 Then
 intDig1 = 0
Else
 intDig1 = 11 - intResto
End If

strcampo = strcampo & intDig1 'concatena o CPF com o primeiro digito verificador
lngSoma = 0
intNumero = 0
intMais = 0
'Inicia cálculos do 2º dígito
For I = 2 To 11
 strCaracter = Right(strcampo, I - 1)
 intNumero = Left(strCaracter, 1)
 intMais = intNumero * I
 lngSoma = lngSoma + intMais
Next I
dblDivisao = lngSoma / 11
lngInteiro = Int(dblDivisao) * 11
intResto = lngSoma - lngInteiro
If intResto = 0 Or intResto = 1 Then
 intDig2 = 0
Else
 intDig2 = 11 - intResto
End If
strConf = intDig1 & intDig2
'Caso o CPF esteja errado dispara a mensagem
If strConf <> Right(CPF, 2) Then
 calculacpf = False
Else
 calculacpf = True
End If
Exit Function

Exit_CPF:
 Exit Function
Err_CPF:
 MsgBox Error$
 Resume Exit_CPF
End Function

Public Function CalculaCGC(Numero As String) As String

Dim I As Integer
Dim prod As Integer
Dim mult As Integer
Dim digito As Integer

If Not IsNumeric(Numero) Then
 CalculaCGC = ""
 Exit Function
End If

mult = 2
For I = Len(Numero) To 1 Step -1
 prod = prod + Val(Mid(Numero, I, 1)) * mult
 mult = IIf(mult = 9, 2, mult + 1)
Next

digito = 11 - Int(prod Mod 11)
digito = IIf(digito = 10 Or digito = 11, 0, digito)

CalculaCGC = Trim(Str(digito))

End Function

Public Function ValidaCGC(CGC As String) As Boolean
If CalculaCGC(Left(CGC, 12)) <> Mid(CGC, 13, 1) Then
 ValidaCGC = False
 Exit Function
End If

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

ValidaCGC = True

End Function

Depois em seu form crie uma textbox e coloque o nome que quiser, mais lembre-se terá que alterar no código onde estiver txtCpfcgc você colocará o nome da sua textbox.

Coloque esse código no evento LostFocus da sua textbox:

.+-If Len(txtCpfcgc.Text) > 0 Then
 Select Case Len(txtCpfcgc.Text)
 Case Is = 11
 txtCpfcgc.Text = Format$(txtCpfcgc, "@@@.@@@.@@@-@@")
 Dim xxxx As String
 xxxx = Replace(txtCpfcgc.Text, ".", "")
 xxxx = Replace(xxxx, "-", "")
 xxxx = Replace(xxxx, "/", "")
 If Not calculacpf(xxxx) Then
 MsgBox "CPF inválido!!!"
 txtCpfcgc = ""
 txtCpfcgc.Text = ""
 txtCpfcgc.SetFocus
 End If
 Case Is = 14
 txtCpfcgc.Text = Format$(txtCpfcgc, "@@.@@@.@@@/@@@@-@@")
 Dim xxx As String
 xxx = Replace(txtCpfcgc.Text, ".", "")
 xxx = Replace(xxx, "-", "")
 xxx = Replace(xxx, "/", "")
 If Not ValidaCGC(xxx) Then
 MsgBox "CNPJ inválido!!! "
 txtCpfcgc = ""
 txtCpfcgc.Text = ""
 txtCpfcgc.SetFocus
 End If
 End Select
 End If

Depois no evento KeyPress coloque :

'Se teclar enter envia um TAB
 If KeyAscii = 13 Then
 SendKeys "{TAB}"
 KeyAscii = 0
 End If

Pronto agora só testar a sua função.
Espero que gostem, qualquer dúvida em relação a ela só deixar um comentário.

15 Assinantes
Assine você também

131 Seguidores
Siga você também

Comente :

Título *: Nome *:
Email *: Site:
Comentário *:

Site | Email | Artigos : 2

Outros artigos do colunista.Validação de CPF/CNPJAplicativo em VB 6.0 com visual ...

php biblioteca cURL dados remotos informações funcao validacao cpf redimensionamento imagens asp senhas user login recuperacao