FUN?ÃO PARA VERIFICAR CNPJ E CPF

ELMO01 12/01/2016 10:28:16
#456004
Oi pessoal,

Alguém ai tem uma função para verificar CNPJ e CPF que funcione, pois achei na rede várias funções mas nenhum funciona perfeitamente.

Obrigado,
FBGSYSTEMS 12/01/2016 10:44:19
#456005 Resposta escolhida
Bom dia amigo.
eu uso essas duas em VB6, nunca deu problema em nenhum cliente.

Public Function Calc_CNPJ(valor As String) As Boolean
    
    Dim Mult1 As String
    Dim Mult2 As String
    Dim dig1 As Integer
    Dim dig2 As Integer
    Dim X As Integer
    
    Mult1 = [Ô]543298765432[Ô]
    Mult2 = [Ô]6543298765432[Ô]
    For X = 1 To 12
        dig1 = dig1 + (Val(Mid$(valor, X, 1)) * Val(Mid$(Mult1, X, 1)))
    Next
    For X = 1 To 13
        dig2 = dig2 + (Val(Mid$(valor, X, 1)) * Val(Mid$(Mult2, X, 1)))
    Next
    dig1 = (dig1 * 10) Mod 11
    dig2 = (dig2 * 10) Mod 11
    If dig1 = 10 Then dig1 = 0
    If dig2 = 10 Then dig2 = 0
    Calc_CNPJ = True
    If dig1 <> Val(Mid$(valor, 13, 1)) Then Calc_CNPJ = False
    If dig2 <> Val(Mid$(valor, 14, 1)) Then Calc_CNPJ = False
    
End Function

Public Function Calc_CPF(valor As String) As Boolean
   
    [ô]Inicializa variaveis
    Dim dig1 As Integer
    Dim dig2 As Integer
    Dim Mult1 As Integer
    Dim Mult2 As Integer
    Dim X As Integer
    
    Mult1 = 10
    Mult2 = 11
    For X = 1 To 9
        dig1 = dig1 + (Val(Mid$(valor, X, 1)) * Mult1)
        Mult1 = Mult1 - 1
    Next
    For X = 1 To 10
        dig2 = dig2 + (Val(Mid$(valor, X, 1)) * Mult2)
        Mult2 = Mult2 - 1
    Next
    dig1 = (dig1 * 10) Mod 11
    dig2 = (dig2 * 10) Mod 11
    If dig1 = 10 Then dig1 = 0
    If dig2 = 10 Then dig2 = 0
    Calc_CPF = True
    If Val(Mid$(valor, 10, 1)) <> dig1 Then Calc_CPF = False
    If Val(Mid$(valor, 11, 1)) <> dig2 Then Calc_CPF = False
    
End Function
ELMO01 12/01/2016 11:32:56
#456014
FBGSYSTEMS - obrigado por ter respondido, agora como vc utiliza esta função no seu sistema?

Obrigado
KURTGU 12/01/2016 11:34:00
#456015
ELMO01 esse funcao dele somente valida o CPF voce precisa que busque as informações no site da Receita federal?
ELMO01 12/01/2016 11:45:58
#456020
KURTGU - não há necessidade de verificar na Receita Federal, quero somente que verifique o CNPJ e o CPF se são válidos.

Obrigado
KURTGU 12/01/2016 11:47:51
#456021
Entendi...

Ja tentou ultilizar esta do marcorreti?
http://www.macoratti.net/vbn_vdoc.htm
ELMO01 12/01/2016 12:41:38
#456023
Sim, mas não gostei muito dela, por isto que estou procurando outra função.
FBGSYSTEMS 12/01/2016 13:44:07
#456025
If calc_cnpj(xxxx) = true then
Valido
Else
Invaludo
IRENKO 12/01/2016 16:59:57
#456042
Eu uso essas:

Function ValidaçãoCNPJ(ByVal sCNPJ As String) As Boolean
[ô]Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Dim sVerificador1 As String
Dim sVerificador2 As String
Dim l As Long
Dim lOffset As Long
Dim lTotal As Long
Dim lResto As Long

[ô]Limpa barras, traços e pontos do CNPJ, caso haja:
sCNPJ = Replace(sCNPJ, [Ô].[Ô], vbNullString)
sCNPJ = Replace(sCNPJ, [Ô]-[Ô], vbNullString)
sCNPJ = Replace(sCNPJ, [Ô]/[Ô], vbNullString)
sCNPJ = Replace(sCNPJ, [Ô] [Ô], vbNullString)

[ô]Verifica se o CNPJ possui 11 caracteres
If Not Len(sCNPJ) = 14 Or Not IsNumeric(sCNPJ) Then Exit Function

[ô]Obtém os dígitos verificadores do CNPJ
sVerificador1 = Mid(sCNPJ, 13, 2)

sCNPJ = Left(sCNPJ, 12)

[ô]Calcula os dígitos verificadores de acordo
[ô]com as regras do Ministério da Fazenda:
[ô]--- Início ---
[ô]O código do laço executará duas vezes
Do Until Len(sCNPJ) = 14
[ô]Rotina para efetuar o cálculo da soma de produtos
lOffset = 2
lTotal = 0
For l = Len(sCNPJ) To 1 Step -1
If lOffset > 9 Then lOffset = 2
lTotal = lTotal + ((Mid(sCNPJ, l, 1)) * lOffset)
lOffset = lOffset + 1
Next l

[ô]Cálculo para obter dígito verificador
l = lTotal Mod 11
l = 11 - l
If l = 10 Or l = 11 Then l = 0

[ô]Concatena o dígito l ao CNPJ
sCNPJ = sCNPJ & CStr(l)
Loop

[ô]Retorna os dígitos verificadores
sVerificador2 = Right(sCNPJ, 2)

[ô]Se comparação entre dígitos verificadores for Verdadeiro,
[ô]então o número do CNPJ é válido:
ValidaçãoCNPJ = (sVerificador1 = sVerificador2)
End Function

Function ValidaçãoCPF(ByVal sCPF As String) As Boolean
[ô]Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Dim sVerificador1 As String
Dim sVerificador2 As String
Dim l As Long
Dim lOffset As Long
Dim lTotal As Long

[ô]Limpa traços e pontos do CPF, caso haja:
sCPF = Replace(sCPF, [Ô].[Ô], vbNullString)
sCPF = Replace(sCPF, [Ô]-[Ô], vbNullString)
sCPF = Replace(sCPF, [Ô] [Ô], vbNullString)

[ô]Verifica se o CPF possui 11 caracteres
If Not Len(sCPF) = 11 Or Not IsNumeric(sCPF) Then Exit Function

[ô]Obtém os dígitos verificadores do CPF
sVerificador1 = Right(sCPF, 2)

sCPF = Left(sCPF, 9)

[ô]Calcula os dígitos verificadores de acordo
[ô]com as regras do Ministério da Fazenda:
[ô]--- Início ---
[ô]O código do laço executará duas vezes
Do Until Len(sCPF) = 11
[ô]Rotina para efetuar o cálculo da soma de produtos
lOffset = 2
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
l = lTotal Mod 11
l = 11 - l
If l = 10 Or l = 11 Then l = 0

[ô]Concatena o dígito l ao CPF
sCPF = sCPF & CStr(l)
Loop
[ô]Os dígitos verifadores são os dois últimos algarismos
sVerificador2 = Right(sCPF, 2)
[ô]--- Fim ---

[ô]Se comparação entre dígitos verificadores for Verdadeiro,
[ô]então o número do CPF é válido:
ValidaçãoCPF = (sVerificador1 = sVerificador2)
End Function

Private Sub TxtCPF_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If ValidaçãoCNPJ(TxtCPF) Or ValidaçãoCPF(TxtCPF) Then
Call Magica(TxtCPF)
Else
MsgBox [Ô]CPF ou CPNJ Inválido[Ô], vbCritical + vbOKOnly, [Ô]Errou[Ô]
End If
End Sub

Private Function Magica(ByRef tCPF As MSForms.TextBox) As String
Dim CPF, cnpj As String
CPF = 11
cnpj = 14
If Len(tCPF) = CPF And IsNumeric(tCPF) Then
tCPF = Format(tCPF.Text, [Ô]@@@.@@@.@@@-@@[Ô])
CPF = CPF + 3
ElseIf Len(tCPF.Text) = cnpj And IsNumeric(tCPF.Text) Then
tCPF.MaxLength = 18
tCPF = Format(tCPF.Text, [Ô]@@.@@@.@@@/@@@@-@@[Ô])
cnpj = cnpj + 4
End If
End Function

Bom, esta adaptada para VBA e funciona muito bem para os meus propositos. Tente ai.
ELMO01 13/01/2016 08:19:52
#456067
Pessoal, consegui fazer pela função do FBGSYSTEMS e deu certo, era o que eu necessitava. Agradeço a todos que se dispuseram a me ajudar.

Obrigado
Tópico encerrado , respostas não são mais permitidas
Voltar