calcul Numéro Siret à partir du Numéro Siren

[loic38]

bonjour à tous
je cherche le précédent post qui traite d'une fonction ou d'une macro permettant de calculer le N° SIRET (14 chiffres) à partir du N° SIREN de 9 chiffres

 

[dg62]

Bonsoir Loic38

a toi de voir si ca peut convenir

http://www.vbfrance.com/code.aspx?id=335

 

[loic38]

merci de ta réponse dg62
malheureusement le lien ne marche pas
peux tu être plus précis ?
merci

 

[dg62]

re


C'est un code de jacques Prestreau trouvé sur VBfrance

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