[VBA EXCEL] VALIDAR CPF


Mostrarei como verificar a validade de um número de CPF (Cadastro de Pessoa Física). 

Function VALIDARCPF(sCPF As String) As Boolean
    Dim lVerificador1 As String
    Dim lVerificador2 As String
    Dim l As Long
    Dim lOffset As Long
    Dim lTotal As Long
    VALIDARCPF = False

    'Limpa traços e pontos do CPF, caso haja:
    Let sCPF = Replace(sCPF, ".", vbNullString)
    Let sCPF = Replace(sCPF, "-", vbNullString)
    Let sCPF = Replace(sCPF, " ", vbNullString)
    
    'Verifica se o CPF possui 11 caracteres e são todos numeros
    If Not Len(sCPF) = 11 Or Not IsNumeric(sCPF) Then Exit Function

    If (sCPF = "00000000000") Or (sCPF = "11111111111") Or (sCPF = "22222222222") Then Exit Function
    If (sCPF = "33333333333") Or (sCPF = "44444444444") Or (sCPF = "55555555555") Then Exit Function
    If (sCPF = "66666666666") Or (sCPF = "77777777777") Or (sCPF = "88888888888") Or (sCPF = "99999999999") Then Exit Function
    
    'Obtém os dígitos verificadores do CPF
    lVerificador1 = Right(sCPF, 2)
    
    Let sCPF = Left(sCPF, 9)
    
    'Calcula os dígitos verificadores de acordo com as regras do Ministério da Fazenda
    Do Until Len(sCPF) = 11
        'Rotina para efetuar o cálculo da soma de produtos
        Let lOffset = 2
        Let lTotal = 0

        For l = Len(sCPF) To 1 Step -1
            lTotal = lTotal + (Mid(sCPF, l, 1) * lOffset)
            lOffset = lOffset + 1
        Next l
        
        'Cálculo para obter dígito verificador
        Let l = lTotal Mod 11
        Let l = 11 - l

        If l = 10 Or l = 11 Then l = 0
        
        'Concatena o dígito l ao CPF
        Let sCPF = sCPF & CStr(l)
    Loop

    'Os dígitos verifadores são os dois últimos algarismos
    lVerificador2 = Right(sCPF, 2)
    
    'Se comparação entre dígitos verificadores for Verdadeiro, então o número do CPF é válido:
    Let VALIDARCPF = (lVerificador1 = lVerificador2)
End Function

Gostou? Deixe seu comentário... Convido você a seguir meu blog, sua presença é bem vinda!

Nenhum comentário:

Postar um comentário