1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49
|
'Définition d'un Type pour le découpage du compte
Type Compte
A As String
B As String
C As String
D As String
End Type
Function RIB(CB As String, CG As String, NC As String) As String
'Calcul de la clé RIB à partir de
'CB : Code Banque (5 caractères)
'CG : Code Guichet (5 caractères)
'NC : N° de Compte (11 caractères)
'Cette fonction prend en compte le remplacement des lettres par des chiffres pour les CCP
Dim MC As Compte
'remplacer les lettres par les chiffres
NC = ChTran(CB & CG & NC, "AJBKSCLTDMUENVFOWGPXHQYIRZ", "11222333444555666777888999")
'* vérification du numéro de compte 21 digits en tout
If Len(NC) <> 21 Then
Err.Raise vbObjectError + 1, "N° Compte", "Attention ! Un numéro de compte doit forcément faire 11 caractères"
End If
'Décomposer le compte en 4 parties
MC.A = Mid(NC, 1, 5)
MC.B = Mid(NC, 6, 5)
MC.C = Mid(NC, 11, 6)
MC.D = Mid(NC, 17, 5)
'Renvoyer la clé RIB
RIB = Format(97 - (89 * Val(MC.A) + 15 * Val(MC.B) + 76 * Val(MC.C) + 3 * Val(MC.D)) Mod 97, "00")
End Function
Function ChTran(ByVal sSource As String, sChainComp As String, sChainCorresp As String) As String
'Cette fonction recherche, pour chaque caractère de sSource s'il est présent dans sChainComp,
'et, si c'est le cas, le remplace par le caractère correspondant dans sChainCorresp
Dim lngNb As Long
Dim lngPos As Long
For lngNb = 1 To Len(sSource)
lngPos = InStr(UCase(sChainComp), UCase(Mid(sSource, lngNb, 1)))
If lngPos <> 0 Then
Mid(sSource, lngNb, 1) = Mid(sChainCorresp, lngPos)
Else
'rien à faire
End If
Next
ChTran = sSource
End Function |
Partager