Calcul siren et siret

Commenter

Contenu du snippet

Comme son nom l'indique. Cette routine calcule ou contrôle un numéro Siren ou un siret entier.

Source / Exemple : 


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

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (Jacques PRESTREAU)