Amigos,
A partir da necessidade de um colega do fórum no tópico: [Resolvido]Gerador de Cpf , criei um algoritmo para gerar automaticamente CPF válidos. Compartilhando com a comunidade.
A função:
Para chamar, coloque no evento que desejar:
Call gerarCPF()
Tópico relacionado a esse:
Considerações, dúvidas e sugestões sobre o Exemplo Gerador de CPF válido
O exemplo:
Versão 2007
https://dl.dropboxusercontent.com/u/8080696/BAP/Ferramentas/GerarCPF.zip
Versão 2003:
A partir da necessidade de um colega do fórum no tópico: [Resolvido]Gerador de Cpf , criei um algoritmo para gerar automaticamente CPF válidos. Compartilhando com a comunidade.
A função:
Sub gerarCPF()
Dim kX
Dim iX As Integer
Dim pesoX As Integer
Dim apuracaoX As Integer
Dim restoX
Dim SomaX
Dim primeiroCV
Dim kY
Dim iY As Integer
Dim pesoY As Integer
Dim apuracaoY As Integer
Dim restoY
Dim SomaY
Dim segundoCV
Dim nRand
Dim nAleatorio As String
'Gerar uma sequência qualquer de 9 números
Randomize
For i = 0 To 8
nRand = Int((9 * Rnd) + 1)
If i = 0 Then
nAleatorio = nRand
Else
nAleatorio = nAleatorio & "." & nRand
End If
Next i
kX = Split(nAleatorio, ".")
'Gerar o Primeiro Digito Verificador
pesoX = 10
For iX = 0 To 8
apuracaoX = kX(iX) * pesoX
pesoX = pesoX - 1
SomaX = SomaX + apuracaoX
Next iX
restoX = SomaX Mod 11
If restoX < 2 Then
primeiroCV = 0
Else
primeiroCV = 11 - restoX
End If
resultadoX = nAleatorio & "." & primeiroCV
kY = Split(resultadoX, ".")
'Gerar o Segundo Digito Verificador
pesoY = 11
For iY = 0 To 9
apuracaoY = kY(iY) * pesoY
pesoY = pesoY - 1
nSomaY = nSomaY + apuracaoY
Next iY
restoY = nSomaY Mod 11
If restoY < 2 Then
segundoCV = 0
Else
segundoCV = 11 - restoY
End If
'Resultado:
Me.txtCPFValido = Replace(resultadoX & "." & segundoCV, ".", "")
End Sub
Para chamar, coloque no evento que desejar:
Call gerarCPF()
Tópico relacionado a esse:
Considerações, dúvidas e sugestões sobre o Exemplo Gerador de CPF válido
O exemplo:
Versão 2007
https://dl.dropboxusercontent.com/u/8080696/BAP/Ferramentas/GerarCPF.zip
Versão 2003:
- Anexos
- GerarCPF2003.zip
- Você não tem permissão para fazer download dos arquivos anexados.
- (16 Kb) Baixado 177 vez(es)
Última edição por Dilson em Dom 16 Nov 2014, 00:36, editado 3 vez(es)