CALCUL SIREN ET SIRET

Option Explicit

Function Clé_Siren(Siren_sur_huit As String) As Byte

Dim Tampon_Siren As String
Dim Position As Byte
Dim Cumul_Siren As Integer

Tampon_Siren = ""
For Position = 1 To 8
   Tampon_Siren = Tampon_Siren + CStr(Val(Mid(Siren_sur_huit, Position, 1)) * IIf((Position Mod 2) = 0, 2, 1))
Next Position

Cumul_Siren = 0
For Position = 1 To Len(Tampon_Siren)
   Cumul_Siren = Cumul_Siren + Val(Mid(Tampon_Siren, Position, 1))
Next Position
Clé_Siren = Right(10 - Val(Right(Cumul_Siren, 1)), 1)

End Function

Function Clé_Siret(Siret_sur_treize As String) As Byte

Dim Tampon_Siret As String
Dim Position As Byte
Dim Cumul_Siret As Integer

Tampon_Siret = ""
For Position = 1 To 13
   Tampon_Siret = Tampon_Siret + CStr(Val(Mid(Siret_sur_treize, Position, 1)) * IIf((Position Mod 2) = 0, 1, 2))
Next Position

Cumul_Siret = 0
For Position = 1 To Len(Tampon_Siret)
   Cumul_Siret = Cumul_Siret + Val(Mid(Tampon_Siret, Position, 1))
Next Position
Clé_Siret = Right(10 - Val(Right(Cumul_Siret, 1)), 1)

End Function

Function Siren_Valide(Siren As String) As Boolean

Dim Tampon_Siren As String
Dim Position As Byte
Dim Cumul_Siren As Integer

Siren_Valide = False
If Len(Siren) <> 9 Then Exit Function

Tampon_Siren = ""
For Position = 1 To 9
   Tampon_Siren = Tampon_Siren + CStr(Val(Mid(Siren, Position, 1)) * IIf((Position Mod 2) = 0, 2, 1))
Next Position

Cumul_Siren = 0
For Position = 1 To Len(Tampon_Siren)
   Cumul_Siren = Cumul_Siren + Val(Mid(Tampon_Siren, Position, 1))
Next Position

Siren_Valide = ((Cumul_Siren Mod 10) = 0)

End Function

Function Siret_Valide(Siret As String) As Boolean

Dim Tampon_Siret As String
Dim Position As Byte
Dim Cumul_Siret As Integer

Siret_Valide = False
If Len(Siret) <> 14 Then Exit Function

If Siren_Valide(Left(Siret, 9)) Then
   Siret_Valide = IsNumeric(Right(Siret, 5))
   If Not Siret_Valide Then
      Exit Function
   Else
      Tampon_Siret = ""
      For Position = 1 To 14
         Tampon_Siret = Tampon_Siret + CStr(Val(Mid(Siret, Position, 1)) * IIf((Position Mod 2) = 0, 1, 2))
      Next Position
      
      Cumul_Siret = 0
      For Position = 1 To Len(Tampon_Siret)
         Cumul_Siret = Cumul_Siret + Val(Mid(Tampon_Siret, Position, 1))
      Next Position
      Siret_Valide = (Cumul_Siret Mod 10 = 0)
   End If

End If

End Function