Function Siret(Siren_et_Etab) 'Siren_et_Etab) '4289122810001
'Siren_et_Etab = CDbl("4289122810001" )
 
Dim Siren_et_Etab2, LngSiren, Val_Rang, Val_14 As Long
    
    
    Siren_et_Etab2 = Siren_et_Etab & "0" 'on ajoute une "clé fictive" pour partir de la 14e place (rang 1)
    LngSiren = Len(Siren_et_Etab2)
    
    For X = LngSiren To 1 Step -1 'on part de la fin
    
    
        Val_Rang = Mid(Siren_et_Etab2, X, 1)
      
        If X Mod 2 = 0 Then 'Si le rang est paire on double
        
            Val_14 = Val_14 + Val_Rang '14e place = rang 1 ; 13e place = rang 2 etc. donc si X est paire, on n'ajoute pas le double
            
        Else
            
            
            If (Val_Rang * 2) > 10 Then 'si le double a 2 chiffres
            
                Val_14 = Val_14 + Left((Val_Rang * 2), 1) + Right((Val_Rang * 2), 1) 'on ajoute l'addition des 2 chiffres du double
                
            Else
            
                Val_14 = Val_14 + (Val_Rang * 2) 'on ajoute le double
                
            End If
            
            
        End If
        
        
    Next X
    
    
    If Val_14 Mod 10 = 0 Then 'si multiple de 10 ok
 
        Siret = Siren_et_Etab & 0
 
    Else
 
        Val_14 = 10 - (Val_14 Mod 10) 'sinon on garde le chiffre des unités du modulo
        Siret = Siren_et_Etab & Val_14
 
    End If
 
 
End Function