begin process at 2008 05 16 05:00:30
1 173 215 membres
57 nouveaux aujourd'hui
13 970 membres club

Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum.
Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

CALCUL SIREN ET SIRET


Information sur la source

Catégorie :Modules Classé sous : calcul, siren, siret Niveau : Débutant Date de création : 21/07/2000 Date de mise à jour : 10/07/2001 00:00:00 Vu : 13 421

Note :
7,88 / 10 - par 8 personnes
7,88 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10

Commentaire sur cette source (1)
Ajouter un commentaire et/ou une note

Description

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

Source

  • 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
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
  • signaler à un administrateur
    Commentaire de brupoc le 20/12/2002 17:16:15

    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,

Ajouter un commentaire

Appels d'offres

Pub



CalendriCode

Mai 2008
LMMJVSD
   1234
567891011
12131415161718
19202122232425
262728293031 

Téléchargements

Boutique

Boutique de goodies CodeS-SourceS