Grande JPaulo, bom dia.
Tenho uma outra função que executa bem a validação do CPF.
Function v_CPF(CPF As String) As String
If CPF = "11111111111" Or CPF = "22222222222" Or CPF = "33333333333" _
Or CPF = "44444444444" Or CPF = "55555555555" Or CPF = "66666666666" _
Or CPF = "77777777777" Or CPF = "88888888888" Or CPF = "99999999999" Or CPF = "00000000000" Then
MsgBox "O CPF é INVÁLIDO! Digite-o novamente.", vbCritical, " InfoBasic Smart System"
Exit Function
End If
Dim lngSoma, lngInteiro As Long
Dim intNumero, intMais, I, intResto As Integer
Dim intDig1, intDig2 As Integer
Dim strDigVer, strcampo, strCaracter, StrConf As String
Dim dblDivisao As Double
lngSoma = 0
intNumero = 0
intMais = 0
strcampo = Left(CPF, 9)
strDigVer = Right(CPF, 2)
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
lngSoma = 0
intNumero = 0
intMais = 0
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
v_CPF = StrConf
'If dvcpf = strDigVer Then
Rem 999.999.999-99
'CPF = Mid(CPF, 1, 3) & "." & Mid(CPF, 4, 6) & "." & Mid(CPF, 7, 9) & "-" & Right(CGC, 2)
'dvcpf = CPF
If v_CPF <> strDigVer Then
'Else
MsgBox "Atenção: O número do CPF informado é inválido. " & Chr(13) & "Por favor, digite novamente. ", vbCritical, " InfoBasic Smart System"
DoCmd.CancelEvent
'MsgBox "CPF válido!", vbInformation
'Else
End If
End Function
No evento Ao sair do campo CPF:
Private Sub CPF_Exit(Cancel As Integer)
If Not IsNull(Me.CPF) Then
v_CPF (Me.CPF)
End If
If IsNull([CPF]) Or IsEmpty([CPF]) Then
'Dispara uma mensagem ao usuário do computador para que ele tome uma decisão. Se ele escolher Ok, então passa a frente
If MsgBox("É recomendado o preenchimento do CPF." & Chr(13) & _
"Deseja não preencher agora e preenchê-lo em outro momento?", vbExclamation + vbOKCancel, " Atenção !!!") = vbOK Then Exit Sub
'Se escolher e apertar Cancelar, então o foco direciona para caixa de texto (Texto2)
Me.CPF.SetFocus
Me.CPF = ""
Cancel = True
End If
End Sub
Funciona de forma quase perfeita, apenas com um detalhe, caso o CPF inicie com o algarismo 0 (zero) acusa como CPF Inválido e nós sabemos que alguns CPFs podem realmente iniciar com 0 (zero)
Daí...
O Mago do VBA teria alguma sugestão?
Por outro lado, tomando o seu exemplo como base e acrescentando parte da função acima o problema dos algarismos idênticos foi resolvido veja abaixo:
Abraços, WSenna
Última edição por wsenna em 14/2/2014, 11:28, editado 1 vez(es)