Calcul siren et siret

Soyez le premier à donner votre avis sur cette source.

Snippet vu 32 874 fois - Téléchargée 72 fois

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

Ajouter un commentaire

Commentaire

brupoc
Messages postés
2
Date d'inscription
vendredi 20 décembre 2002
Statut
Membre
Dernière intervention
20 décembre 2002
-
pas mal! Avec le RIB et le Siret je suis déjà bien outillé. Il ne manque plus que le n° de TVA intracom, t'aurais pas çà sous le coude ?
Slts,

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.