|
Sujet : Clé SIRET |
| SuppotDeSaTante |
J'me suis débrouillé, ça a l'air d'être bon, j'en ai vérifié 3-4 Si ça peut servir à d'autre :
Code :
Function Siret(Siren_et_Etab) 'Siren_et_Etab) '4289122810001 'Siren_et_Etab = CDbl("4289122810001" ) Dim Siren_et_Etab2, LngSiren, Val_Rang, Val_14 As Long Siren_et_Etab2 = Siren_et_Etab & "0" 'on ajoute une "clé fictive" pour partir de la 14e place (rang 1) LngSiren = Len(Siren_et_Etab2) For X = LngSiren To 1 Step -1 'on part de la fin Val_Rang = Mid(Siren_et_Etab2, X, 1) If X Mod 2 = 0 Then 'Si le rang est paire on double Val_14 = Val_14 + Val_Rang '14e place = rang 1 ; 13e place = rang 2 etc. donc si X est paire, on n'ajoute pas le double Else If (Val_Rang * 2) > 10 Then 'si le double a 2 chiffres Val_14 = Val_14 + Left((Val_Rang * 2), 1) + Right((Val_Rang * 2), 1) 'on ajoute l'addition des 2 chiffres du double Else Val_14 = Val_14 + (Val_Rang * 2) 'on ajoute le double End If End If Next X If Val_14 Mod 10 = 0 Then 'si multiple de 10 ok Siret = Siren_et_Etab & 0 Else Val_14 = 10 - (Val_14 Mod 10) 'sinon on garde le chiffre des unités du modulo Siret = Siren_et_Etab & Val_14 End If End Function
|
|
