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