Functie VBA ce genereaza CNP-uri valide fictive

Mergand pe algoritmul de validare al unui cod CNP, se poate construi foarte usor o functie ce genereaza CNP-uri fictive valide.

Function Random_CNP() As String
Dim i As Integer
Dim cnp_array(12) As Integer, Sir2(13) As Integer
Dim temporar As String
Dim rnd_sex As Integer, rnd_an As Integer
Dim rnd_luna As Integer, rnd_zi As Integer
Dim rnd_Judet As Integer, rnd_nr As Integer
Dim x As Integer
Dim Sex As String, An As String, Luna As String, Zi As String, Judet As String, Cod As String, ultima As String

rnd_sex = Int((2 - 1 + 1) * Rnd + 1)
rnd_an = Int((Year(Date) - 1900 + 1) * Rnd + 1900)
rnd_luna = Int((12 - 1 + 1) * Rnd + 1)
rnd_zi = Int((28 - 10 + 1) * Rnd + 10)
rnd_Judet = Int((52 - 1 + 1) * Rnd + 1)
rnd_nr = Int((999 - 100 + 1) * Rnd + 100)

If rnd_an >= 2000 Then
Sex = rnd_sex + 4
Else
Sex = rnd_sex
End If

An = Mid(CStr(rnd_an), 3, 2)

If rnd_luna < 10 Then
Luna = "0" & rnd_luna
Else
Luna = rnd_luna
End If

If rnd_zi < 10 Then
Zi = "0" & rnd_zi
Else
Zi = rnd_zi
End If

If rnd_Judet < 10 Then
Judet = "0" & rnd_Judet
Else
Judet = rnd_Judet
End If

Cod = rnd_nr

temporar = Sex & An & Luna & Zi & Judet & Cod

For i = 1 To 12
cnp_array(i) = Mid(temporar, i, 1)
Next i
x = (cnp_array(1) * 2 + cnp_array(2) * 7 + cnp_array(3) * 9 + cnp_array(4) * 1 + cnp_array(5) * 4 + cnp_array(6) * 6 + _
        cnp_array(7) * 3 + cnp_array(8) * 5 + cnp_array(9) * 8 + cnp_array(10) * 2 + cnp_array(11) * 7 + cnp_array(12) * 9) Mod 11
        If x = 10 Then x = 1

ultima = CStr(x)
Random_CNP = Sex & An & Luna & Zi & Judet & Cod & ultima

End Function

Spor !

Calculul Datei Nasterii din CNP

Functia trateaza si CNP-urile persoanelor straine rezidente (al caror CNP incepe cu 7 sau 8 in functie de sex) sau al persoanelor straine ce nu sunt rezidente (avand 9 prima cifra din CNP) cu conditia ca persoana respectiva sa fie nascuta dupa 1920 - in caz contrar va afisa eronat secolul.
Inainte de a folosi formula, va recomand sa verificati corectitudinea CNP-urilor din tabela voastra folosind functia de validare CNP-uri.

Function Data_Nasterii(CNP As String) As Date
Dim An As Integer, Luna As Integer, Zi As IntegerSelect Case Left(CNP, 1)
Case 1, 2
An = CInt("19" & Mid(CNP, 2, 2))
Case 5, 6
An = CInt("20" & Mid(CNP, 2, 2))
Case 7, 8, 9
    If CInt(Mid(CNP, 2, 2)) < 20 Then
        An = CInt("20" & Mid(CNP, 2, 2))
    Else
        An = CInt("19" & Mid(CNP, 2, 2))
    End If
End SelectLuna = CInt(Mid(CNP, 4, 2))
Zi = CInt(Mid(CNP, 6, 2))
Data_Nasterii = DateSerial(An, Luna, Zi)
End Function

Functie VBA ce valideaza CNP-uri

Fiindca lucrez destul de des cu ele, am scris o functie in VBA ce verifica daca un CNP este corect sau nu.
Pentru mai multe detalii despre cum se atribuie un CNP si ce reprezinta fiecare cifra din el, va invit sa cititi aici.

Function Validare_CNP(CNP As String) As String
    Dim i As Integer, x As Integer
    Dim cnp_array(13) As Integer
   If Len(CNP) <> 13 Then
        Validare_CNP = "CNP-ul nu are 13 cifre" ' daca CNP-ul nu are 13 caractere atunci functia returneaza mesajul "CNP-ul nu are 13 cifre"
    Else
        For i = 1 To 13
        cnp_array(i) = Val(Mid(CNP, i, 1))
        Next i
        x = (cnp_array(1) * 2 + cnp_array(2) * 7 + cnp_array(3) * 9 + cnp_array(4) * 1 + cnp_array(5) * 4 + cnp_array(6) * 6 + _
        cnp_array(7) * 3 + cnp_array(8) * 5 + cnp_array(9) * 8 + cnp_array(10) * 2 + cnp_array(11) * 7 + cnp_array(12) * 9) Mod 11
            If x = 10 Then
               x = 1
            End If
        If x = cnp_array(13) Then
        Validare_CNP = "Valid" ' daca rezultatul calculului de mai sus este egal cu a 13-a cifra din CNP atunci CNP-ul este valid
        Else
        Validare_CNP = "Invalid"
        End If
    End If
    End Function

Spor