Vérification de la validité d'un SIREN et d'un SIRET [Sources]

[Shamard]

Bonjour,
Ayant un peu galéré pour le faire, je vous poste ces deux bouts de code (certainement perfectibles) pour tous ceux qui cherchent...

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
 
Private Sub Siretemployeur_AfterUpdate()
On Error GoTo Siretemployeur_AfterUpdate_Error
 
    Dim numerosaisi As String
    Dim numerotest As Variant
    Dim i As Integer
    Dim j As Integer
    Dim grille1(9, 0)
    Dim grille2(18, 0)
    Dim A As Variant
    Dim a1 As Byte
    Dim a2 As Byte
    Dim atester As Single
    Dim resultat As Variant
 
'initialisation des variables
    i = 1
    j = 1
    numerosaisi = Me.ActiveControl
    numerotest = Left(numerosaisi, 9)
    atester = 0
'décomposition du SIREN dans grille1
    Do Until (9 - i) = -1
        grille1(i, 0) = Left(numerotest, 1)
'si rang impaire *1 si rang paire *2
    Select Case (i)
        Case 1, 3, 5, 7, 9
            A = grille1(i, 0) * 1
        Case 2, 4, 6, 8
            A = grille1(i, 0) * 2
       End Select
       a1 = IIf(Len(A) = 2, Left(A, 1), 0)
       a2 = IIf(Len(A) = 2, Right(A, 1), A)
'alimentation des resultats dans grille2
       grille2(j, 0) = a1
       grille2(j + 1, 0) = a2
       j = j + 2
'on passe au digit suivant
       numerotest = IIf((9 - i) > 0, Right(numerotest, (9 - i)), numerotest)
    i = i + 1
    Loop
'addition des digits de grille 2
    For j = 1 To 18
    atester = atester + grille2(j, 0)
    Next j
    resultat = atester Mod 10
'on teste le modulo 10
    If resultat <> 0 Then
        MsgBox "NUMERO SIREN INVALIDE", vbExclamation
        Exit Sub
    Else
        MsgBox "NUMERO SIREN VALIDE", vbExclamation
        Call controle_siretemployeur
    End If
   On Error GoTo 0
   Exit Sub
 
Siretemployeur_AfterUpdate_Error:
 
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Siretemployeur_AfterUpdate "
End Sub
'--------------------------------------------------------------------------
Private Sub controle_siretemployeur()
   On Error GoTo controle_siretemployeur_Error
    Dim numerosaisi As String
    Dim numerotest As Variant
    Dim i As Integer
    Dim j As Integer
    Dim grille1(12, 0)
    Dim grille2(26, 0)
    Dim n As Byte
    Dim A As Variant
    Dim a1 As Byte
    Dim a2 As Byte
    Dim atester As Single
    Dim resultat As Variant
'initialisation des variables
    i = 0
    j = 1
    numerosaisi = Me.ActiveControl
    numerotest = Left(numerosaisi, 13)
'conservation de la clef
    n = Right(numerosaisi, 1)
    atester = 0
'décomposition du SIRET dans grille1 avec premier digit en rang 0
    Do Until (12 - i) = -1
       grille1(i, 0) = Left(numerotest, 1)
'si rang impaire *1 si rang paire *2
       Select Case (i)
        Case 1, 3, 5, 7, 9, 11
            A = grille1(i, 0) * 1
        Case 0, 2, 4, 6, 8, 10, 12
            A = grille1(i, 0) * 2
       End Select
'décomposition en 2 digits
       a1 = IIf(Len(A) = 2, Left(A, 1), 0)
       a2 = IIf(Len(A) = 2, Right(A, 1), A)
'alimentation des resultats dans grille2
       grille2(j, 0) = a1
       grille2(j + 1, 0) = a2
       j = j + 2
'on passe au digit suivant
        numerotest = IIf((12 - i) > -1, Right(numerotest, (12 - i)), numerotest)
    i = i + 1
    Loop
'addition des digits de grille 2
    For j = 1 To 26
    atester = atester + grille2(j, 0)
    Next j
'on ajoute la clef
    atester = atester + n
    resultat = atester Mod 10
'on teste le modulo 10
    If resultat <> 0 Then
        MsgBox "NUMERO SIRET INVALIDE", vbExclamation
        Exit Sub
    Else
        MsgBox "NUMERO SIRET VALIDE", vbExclamation
    End If
   On Error GoTo 0
   Exit Sub
controle_siretemployeur_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure controle_siretemployeur of Document VBA Form_F_TRANSIT DDTEFP ETABLISSEMENTS"
End Sub

et voilà... Merci encore pour toutes les infos que je trouve grace à vous.

[Tofalu]

Il faudrait en faire une fonction indépendante qui renverra vrai ou faux suivant que le siren est correct ou pas. Là le code est un peu indigeste

[Shamard]

Envoyé par Tofalu

Il faudrait en faire une fonction indépendante qui renverra vrai ou faux suivant que le siren est correct ou pas. Là le code est un peu indigeste

Voilà voilà le code des 2 fonctions qui renvoient True si OK et false si KO!
En meme temps, "Tofalu" en 3 mn t'avais pas vraiment le temps de te pencher sur la question je pense...

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
 
'---------------------------------------------------------------------------------------
' Fonction : VerifSiren
' DateTime  : 20/03/2007 17:11
' Author    : HAMARD
' Purpose   : Vérification de la validité du numéro de Siren d'une entreprise
'             Passer le Numéro de Siren ou de Siret (mini 9 chiffres) en parametre
'             renvoie True si OK
'---------------------------------------------------------------------------------------
'
Public Function VérifSiren(Siret As String) As Boolean
 
 
    Dim numerosaisi As String
    Dim numerotest As Variant
    Dim i As Integer
    Dim j As Integer
    Dim grille1(9, 0)
    Dim grille2(18, 0)
    Dim A As Variant
    Dim a1 As Byte
    Dim a2 As Byte
    Dim atester As Single
    Dim resultat As Variant
 
 
 
'initialisation des variables
   On Error GoTo VérifSiren_Error
 
    i = 1
    j = 1
    numerosaisi = Siret
    numerotest = Left(numerosaisi, 9)
    atester = 0
 
'décomposition du SIREN dans grille1
 
 
    Do Until (9 - i) = -1
 
        grille1(i, 0) = Left(numerotest, 1)
'si rang impaire *1 si rang paire *2
 
       Select Case (i)
        Case 1, 3, 5, 7, 9
            A = grille1(i, 0) * 1
        Case 2, 4, 6, 8
            A = grille1(i, 0) * 2
       End Select
 
       a1 = IIf(Len(A) = 2, Left(A, 1), 0)
       a2 = IIf(Len(A) = 2, Right(A, 1), A)
'alimentation des resultats dans grille2
 
       grille2(j, 0) = a1
       grille2(j + 1, 0) = a2
       j = j + 2
 
'on passe au digit suivant
 
        numerotest = IIf((9 - i) > 0, Right(numerotest, (9 - i)), numerotest)
    i = i + 1
    Loop
 
'addition des digits de grille 2
 
    For j = 1 To 18
    atester = atester + grille2(j, 0)
    Next j
 
    resultat = atester Mod 10
 
'on teste le modulo 10
 
    If resultat <> 0 Then
        VérifSiren = False
    Else
        VérifSiren = True
    End If
 
 
   On Error GoTo 0
   Exit Function
 
VérifSiren_Error:
 
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure VérifSiren of Module Général"
 
End Function
'
'---------------------------------------------------------------------------------------
' Procedure : VérifSiret
' DateTime  : 16/04/2007 17:02
' Author    : HAMARD
' Purpose   : Vérification de la validité du n° de Siret d'une entreprise
'             Passer le Numéro de Siret en parametre
'             renvoie True si OK
'---------------------------------------------------------------------------------------
'
Public Function VérifSiret(Siret As String) As Boolean
 
 
    Dim numerosaisi As String
    Dim numerotest As Variant
    Dim i As Integer
    Dim j As Integer
    Dim grille1(12, 0)
    Dim grille2(26, 0)
    Dim n As Byte
    Dim A As Variant
    Dim a1 As Byte
    Dim a2 As Byte
    Dim atester As Single
    Dim resultat As Variant
 
'initialisation des variables
   On Error GoTo VérifSiret_Error
 
    i = 0
    j = 1
    numerosaisi = Siret
    numerotest = Left(numerosaisi, 13)
 
'conservation de la clef
 
    n = Right(numerosaisi, 1)
    atester = 0
 
'décomposition du SIRET dans grille1 avec premier digit en rang 0
 
 
    Do Until (12 - i) = -1
 
        grille1(i, 0) = Left(numerotest, 1)
 
'si rang impaire *1 si rang paire *2
 
       Select Case (i)
        Case 1, 3, 5, 7, 9, 11
            A = grille1(i, 0) * 1
        Case 0, 2, 4, 6, 8, 10, 12
            A = grille1(i, 0) * 2
       End Select
 
'décomposition en 2 digits
 
       a1 = IIf(Len(A) = 2, Left(A, 1), 0)
       a2 = IIf(Len(A) = 2, Right(A, 1), A)
 
'alimentation des resultats dans grille2
 
       grille2(j, 0) = a1
       grille2(j + 1, 0) = a2
       j = j + 2
 
'on passe au digit suivant
 
        numerotest = IIf((12 - i) > -1, Right(numerotest, (12 - i)), numerotest)
    i = i + 1
    Loop
 
'addition des digits de grille 2
 
    For j = 1 To 26
    atester = atester + grille2(j, 0)
    Next j
 
'on ajoute la clef
 
    atester = atester + n
 
    resultat = atester Mod 10
 
'on teste le modulo 10
 
    If resultat <> 0 Then
        verifsiret = False
    Else
        verifsiret = True
    End If
 
 
   On Error GoTo 0
   Exit Function
 
VérifSiret_Error:
 
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure VérifSiret of Module Général"
 
End Function

Merci encore pour tout ce que je trouve comme aide ici...

[philben]

Bonjour Shamard,

Humble félicitation pour l'idée et l'amélioration de la lisibilité du code.

Un petit problème : la fonction VérifSiret a un <é> et votre code contient <VerifSiret> sans accent d'où une erreur signalée à la compilation.
Je pense qu'il vaut mieux éviter les caractères particuliers dans le nom des fonctions.

J'ai fouiné sur le web et j'ai écrit une fonction générique qui check en plus la clef de contrôle des cartes de crédit à 16 chiffres :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
 
' Utilisé par la fonction CheckLuhn
Public Enum eTypeLuhn
   eCarteDeCredit
   eSiren
   eSiret
End Enum
 
'---------------------------------------------------------------------------------------
' Procédure    : CheckLuhn [Function]
' Retour       : Boolean (vrai si clef correcte) et la valeur de la clef (iKey)
' Version      : 1.0
' Auteur       : PhilBen
' Création/Maj : Le mardi 17 avril 2007
' Objet        : - Vérifier la clef de contrôle d'un numéro construit selon
'                  l'algorithme de Luhn.
'                - Attention ! une clef correcte ne signifie pas que
'                  le numéro soit valide...
'                - Fonctionne pour les numéros de carte de crédit, Siren et Siret
' Dépendances  : Enum eTypeLuhn et la fonction CalcLuhn
'---------------------------------------------------------------------------------------
Public Function CheckLuhn(ByVal sNumber As String, ByVal eTL As eTypeLuhn, _
                          ByRef iKey As Integer) As Boolean
   iKey = -1
   Select Case eTL
      Case eTypeLuhn.eCarteDeCredit
         CheckLuhn = CalcLuhn(sNumber, 16, 1, iKey)
      Case eTypeLuhn.eSiren
         CheckLuhn = CalcLuhn(sNumber, 9, 0, iKey)
      Case eTypeLuhn.eSiret
         CheckLuhn = CalcLuhn(sNumber, 14, 1, iKey)
   End Select
End Function
 
'---------------------------------------------------------------------------------------
' Procédure    : CalcLuhn  [Private Function] appelée par CheckLuhn
' Retour       : Boolean (vrai si clef correcte) et la valeur de la clef (iKey)
' Version      : 1.0
' Auteur       : PhilBen
' Création/Maj : Le mardi 17 avril 2007
' Objet        : Voir fonction CheckLuhn
' Référence    : <a href="http://en.wikipedia.org/wiki/Luhn_algorithm" target="_blank">http://en.wikipedia.org/wiki/Luhn_algorithm</a>
'---------------------------------------------------------------------------------------
Private Function CalcLuhn(ByVal sNumber As String, ByVal byLenNumberWithKey As Byte, _
                            ByVal byParity As Byte, ByRef iKey As Integer) As Boolean
   Dim bNoKey As Boolean
   Dim i As Integer, iVal As Integer, iStartPos As Integer, iSum As Integer
   sNumber = Trim$(sNumber)
   iStartPos = Len(sNumber)
   If iStartPos = byLenNumberWithKey - 1 Then bNoKey = True
   If bNoKey Or iStartPos = byLenNumberWithKey Then
      iSum = 0
      For i = iStartPos To 1 Step -1
         iVal = val(Mid$(sNumber, i, 1))
         If i Mod 2 = byParity Then
            iVal = iVal * 2
            If iVal > 9 Then iVal = iVal - 9
         End If
         iSum = iSum + iVal
      Next i
      If bNoKey Then
         iKey = (10 - (iSum Mod 10)) Mod 10
         If byLenNumberWithKey Mod 2 = byParity Then iKey = iKey / 2
      ElseIf (iSum Mod 10) = 0 Then
         iKey = Right$(sNumber, 1)
         CalcLuhn = True
      End If
   End If
End Function

Exemples d'utilisation :

Code :

1
2
3
4
5
6
7
 
Dim iclef As Integer
' Mon numéro de CB mais chut !
 MsgBox "CB Ok ? " & CheckLuhn("4973101234567890", eCarteDeCredit, iclef) & " Clef : " & iclef
 MsgBox "CB Ok (manque clef) ? " & CheckLuhn("497010000030052", eCarteDeCredit, iclef) & " Clef : " & iclef
 MsgBox "Siren Ok ? " & CheckLuhn("732829320", eSiren, iclef) & " Clef : " & iclef
 MsgBox "Siret Ok ? " & CheckLuhn("73282932000074", eSiret, iclef) & " Clef : " & iclef

Grâce à vous j'ai découvert l'algorithme de Luhn et le contrôle de clefs

Cordialement,

Philippe

[Shamard]

Envoyé par philben

Bonjour Shamard,

Humble félicitation pour l'idée et l'amélioration de la lisibilité du code.

Un petit problème : la fonction VérifSiret a un <é> et votre code contient <VerifSiret> sans accent d'où une erreur signalée à la compilation.
Je pense qu'il vaut mieux éviter les caractères particuliers dans le nom des fonctions.

Merci, Merci pour tous ces compliments !!! que je ne mérite pas...
Effectivement, j'ai vu (apres avoir posté) qu'il restait cette petite erreur due sans doute à un reste de conditionnement scolaire !!! orthographe quand tu nous tiens !
Mais je suis comme vous, je pense qu'il vaut mieux éviter les caractères accentués dans les procédures et les fonctions.

En tous cas, merci également pour votre travail de recherche sur LUHN ainsi que les vérifications du N° de CB.

[Middle44]

Bonjour,

Etant en train de débuter une nouvelle base Access avec une table Client qui contient un SIRET, j'ai choisi d'ajouter une ValidationRule qui teste directement la validité du numéro SIRET(14 chiffres en masque de saisie SIRET avec espaces) lorsqu'on rentre le SIRET dans un nouvel enregistrement.
Pour se faire, j'ai inscrit la formule suivante dans le générateur d'expression du VALIDE SI :

(((2*ExtracChaîne([SIRET];1;1)) Mod 9)+ExtracChaîne([SIRET];2;1)+((2*ExtracChaîne([SIRET];3;1)) Mod 9)+ExtracChaîne([SIRET];5;1)+((2*ExtracChaîne([SIRET];6;1)) Mod 9)+ExtracChaîne([SIRET];7;1)+((2*ExtracChaîne([SIRET];9;1)) Mod 9)+ExtracChaîne([SIRET];10;1)+((2*ExtracChaîne([SIRET];11;1)) Mod 9)+ExtracChaîne([SIRET];13;1)+((2*ExtracChaîne([SIRET];14;1)) Mod 9)+ExtracChaîne([SIRET];15;1)+((2*ExtracChaîne([SIRET];16;1)) Mod 9)+ExtracChaîne([SIRET];17;1)) Mod 10=0

NB : les caractères 4, 8 et 12 ne sont pas utilisés au regard du masque de saisie du numéro SIRET qui est 000 000 000 00000.

Certes on pourra reprocher que la formule est un peu longuette mais ça fonctionne et c'est bien le principal, de plus celà évite d'avoir recours à une macro...