estevaorada

ValidaCPF VBA

Jun 10th, 2021
831
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Function VALIDACPF(lNumCPF As String)
  2.     Application.Volatile
  3.     Dim lMultiplicador  As Integer
  4.     Dim lDv1            As Integer
  5.     Dim lDv2            As Integer
  6.     lMultiplicador = 2
  7.    
  8.     'Realiza o preenchimento dos zeros á esquerda
  9.    lNumCPF = String(11 - Len(lNumCPF), "0") & lNumCPF
  10.    
  11.     'Realiza o cálculo do dividendo para o dv1 e o dv2
  12.    For i = 9 To 1 Step -1
  13.         lDv1 = (Mid(lNumCPF, i, 1) * lMultiplicador) + lDv1
  14.        
  15.         lDv2 = (Mid(lNumCPF, i, 1) * (lMultiplicador + 1)) + lDv2
  16.        
  17.         lMultiplicador = lMultiplicador + 1
  18.     Next
  19.    
  20.     'Realiza o cálculo para chegar no primeiro dígio
  21.    lDv1 = lDv1 Mod 11
  22.    
  23.     If lDv1 >= 2 Then
  24.         lDv1 = 11 - lDv1
  25.     Else
  26.         lDv1 = 0
  27.     End If
  28.    
  29.     'Realiza o cálculo para chegar no segundo dígido
  30.    lDv2 = lDv2 + (lDv1 * 2)
  31.    
  32.     lDv2 = lDv2 Mod 11
  33.    
  34.     If lDv2 >= 2 Then
  35.         lDv2 = 11 - lDv2
  36.     Else
  37.         lDv2 = 0
  38.     End If
  39.    
  40.     'Realiza a validação e retorna na função
  41.    If Right(lNumCPF, 2) = CStr(lDv1) & CStr(lDv2) Then
  42.     ' Sugestão: Trocar para True ou False caso queira utilizar dentro da função SE
  43.        VALIDACPF = "CPF Válido"
  44.     Else
  45.         VALIDACPF = "CPF Inválido"
  46.     End If
  47.     ' Fonte: https://tinyurl.com/validacpfsite
  48. End Function
RAW Paste Data