Calcul Cle IBAN

[Michael DELIQUE]

Code : Tout sélectionner

Function CleIBAN(wBBAN As String,wCodePays As String )As String
   
   'Génére la clé d'un N° IBAN
   'ne pas mettre le code pays ni la clé dans le N° BBAN passé en parametre mais passer le code BBAN
   
   'Déclaration Variables
   Dim   lstValue List As String
   Dim Temp1 As String
   Dim Temp2 As String
   Dim Char As String
   Dim i As Integer
   
   On Error Goto ErreurHandle
   
   If Trim(wBBAN) = "" Then
      CleIBAN = ""
      Exit Function
   End If
   If Trim(wCodePays) = "" Then
      CleIBAN = ""
      Exit Function
   Elseif Len(Trim(wCodePays))<> 2Then
      CleIBAN = ""
      Exit Function
   End If
   
   'elemination des caracteres superflux
   Temp1 = ""
   For i = 1 To Len(wBBAN)
      Char = Mid(wBBAN,i,1)
      If Char Like "[a-z,A-Z,0-9]"  Then
         Temp1 = Temp1 + Ucase(Char)
      End If
      Char = ""
   Next
   
   'le code BBAN ne peux pas faire plus de 30 caractères
   If Len(Temp1)>30 Then
      CleIBAN = ""
      Exit Function
   End If
   
   lstValue("A") = "10"
   lstValue("B") = "11"
   lstValue("C") = "12"
   lstValue("D") = "13"
   lstValue("E") = "14"
   lstValue("F") = "15"
   lstValue("G") = "16"
   lstValue("H") = "17"
   lstValue("I") = "18"
   lstValue("J") = "19"
   lstValue("K") = "20"
   lstValue("L") = "21"
   lstValue("M") = "22"
   lstValue("N") = "23"
   lstValue("O") = "24"
   lstValue("P") = "25"
   lstValue("Q") = "26"
   lstValue("R") = "27"
   lstValue("S") = "28"
   lstValue("T") = "29"
   lstValue("U") = "30"
   lstValue("V") = "31"
   lstValue("W") = "32"
   lstValue("X") = "33"
   lstValue("Y") = "34"
   lstValue("Z") = "35"   
   lstValue("0") = "0"
   lstValue("1") = "1"
   lstValue("2") = "2"
   lstValue("3") = "3"
   lstValue("4") = "4"
   lstValue("5") = "5"
   lstValue("6") = "6"
   lstValue("7") = "7"
   lstValue("8") = "8"
   lstValue("9") = "9"
   
   'on rajoute le code du pays et la clé de controle vide
   Temp2 = Temp1+Ucase(wCodePays)+"00"
   Temp1 = ""
   
   'conversion des lettres en chiffres
   For i = 1 To Len(Temp2)
      Char = Mid(Temp2,i,1)
      Temp1 = Temp1 + lstValue(Ucase(Char))
      Char = ""
   Next
   Erase lstValue
   Temp2 = ""
   
   i = 98-(ModuloBigNumber(Temp1,97))
   If i <10 Then
      CleIBAN = "0"+Cstr(i)
   Else
      CleIBAN = +Cstr(i)
   End If   
   
   i=0
   Temp1 = ""
   
   Exit Function
ErreurHandle:
   Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   CleIBAN = ""
   Exit Function   
End Function

Code : Tout sélectionner

Function ModuloBigNumber(wNumber As String, wnbDiviseur As Long) As Integer
   
   'cette fonction permet de faire un modulo sur un tres grand nombre entier  ne pouvant pas être géré par la functon Mod
   Dim LeftNumber As String
   Dim RightNumber As String
   Dim i As Integer
   
   On Error Goto ErreurHandle
   
   If Trim(wNumber) = "" Then
      ModuloBigNumber = -1
      Exit Function
   End If
   
   'vérifie qu'il n'y que des chiffres
   If wNumber Like "*[!0-9]*"  Then
      ModuloBigNumber = -1
      Exit Function
   End If
   
   i = Len(Cstr(wnbDiviseur))
   LeftNumber = Left(wNumber, i)
   RightNumber = Mid(wNumber, i+1)
   
   Do
      LeftNumber = Cstr(Clng(LeftNumber) Mod wnbDiviseur)
      LeftNumber= LeftNumber + Left(RightNumber, 1)
      RightNumber= Mid(RightNumber, 2)
   Loop While RightNumber<>""
   
   ModuloBigNumber = Clng(LeftNumber) Mod wnbDiviseur
   
   RightNumber = ""
   LeftNumber = ""
   
   
   Exit Function
ErreurHandle:
   Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   ModuloBigNumber = -1
   Exit Function   
End Function