Rem ===============================================================
Rem
Rem  Nom de module:   LesNombres.bas
Rem  Fonction:  convertit un nombre de 0 à 999.999.999.999,99 en lettre ; Rem donc de :  Zéro … Neuf cent quatre vingt dix neuf milliard, Neuf cent quatre
Rem              vingt dix neuf million, Neuf cent quatre vingt dix neuf mille, Neuf cent
Rem              quatre vingt dix neuf, virgule, quatre vingt dix neuf
Rem
Rem  Création:             Université de Ngaoundere, le juin 2003,
Rem  Auteur :               Oumarou Mamoudou
Rem  Modification:
Rem  Remarque:           fonctionne sous MS-EXEL et MS-ACCESS, Visual Basic
Rem 
Rem ===============================================================

'>>Conertit un chiffre en lettre: exemple
'>>1000 F -> Mille francs
Public Function montantEnLettres(Nombre As Double) As String
'>>------------------------------------------------
montantEnLettres = Trim(enLettres((Nombre))) + " Francs"
'>>------------------------------------------------
End Function

'>>Conertit un chiffre en lettre: exemple
'>>1000 -> Mille francs
Public Function montantEnLettresF(Nombre As Currency) As String
'>>------------------------------------------------
Dim pe As Double, pd As Double
Dim pdtext As String, pdtextR As String, lon As Integer

pe = Fix(Nombre)    '->69000
pd = CDbl(Nombre - pe)    '0,50=0,5 , 0,05 0,57
pdtext = CStr(10000 + (pd * 10000) + 1) '"10001"
pdtextR = getTextNuF(pdtext)

If (pdtextR = "") Then
montantEnLettresF = Trim(enLettres((pe))) & " Francs"
Else
montantEnLettresF = Trim(enLettres((pe))) & " , " & Trim(pdtextR) & " Francs"
End If
'>>------------------------------------------------
End Function

Private Function getTextNuF(Ti As String) As String
'>>------------------------------------------------
Dim Ur As String, Cr As String, tr As String
Dim U As String, C As String, t As String

'>> Exemple Nombres à traiter: NT:= 15001, 10501, 15701, 10001
Cr = Left(Ti, 3)     '>> extraire de la gauche de NT un nombre à 3 chiffres: 150 105 157 100
Ur = Right(Cr, 2)  '>> extraire de la droite de Cr un nombre à 2 chiffre: 50 05 57 00

'>> Exemple Nombres à traiter: Cr:= 50 , 05 , 57 , 00
U = Right(Ur, 1) '>> extraire de la droite de Cr un nombre à 1 chiffres: 0 5 7 0
C = Left(Ur, 1)  '>> extraire de la gauche de Cr un nombre à 1 chiffre:  5 0 5 0

If ((CInt(C) = 0) And (CInt(U) = 0)) Then
t = ""   '>> déterminer le nombre 0 ou bien 00.
ElseIf ((CInt(C) = 0) And (CInt(U) <> 0)) Then
t = getNombre99(U)  '>> déterminer les unités de 0 à 9
ElseIf ((CInt(C) <> 0) And (CInt(U) = 0)) Then
t = getNombre99(CStr(CInt(C) * 10))  '>> déterminer les dizaines de 10 à 90
ElseIf ((CInt(C) <> 0) And (CInt(U) <> 0)) Then
t = getNombre99(CStr((CInt(C) * 10) + CInt(U))) '>> déterminer les nombres de 11 à 99
End If
getTextNuF = Trim(t)
'>>------------------------------------------------
End Function

'>>Conertit un chiffre en lettre: exemple
'>>1000 -> Mille   >> enLettres (1000,"Francs"
'>>1000 -> Mille Francs avec unite="Francs"
Public Function enLettres(Nombre As Double, Optional unite As String) As String
'>>------------------------------------------------
Dim T0 As String, MASK As Long
Dim Tn As String, LTn As String, Tn1 As String, Ln As Integer
Dim I As Integer, val(5) As String, t As String
Dim CT As String, lon As Integer

'>>Extraction des nombres à 3 chiffres
'>>-----------------------------------
T0 = CStr(CDbl(1000000000000#) + Fix(Nombre))
val(0) = T0
Tn1 = T0
For I = 1 To 3
Ln = Len(Tn1)
LTn = Left(Tn1, Ln - 3)
Tn = Right(Tn1, 3)
val(I) = Tn
Tn1 = LTn
Next I
Tn = Right(LTn, 3)
LTn = Left(Tn, 1)
val(4) = Tn

'>>Cnvertir des nombres à 3 chiffres en lettres
'>>--------------------------------------------
For I = 3 To 0 Step -1
If (convert(CStr(val(I + 1)), I) = "") Then
t = t + Trim(convert(CStr(val(I + 1)), I))
Else
t = t + Trim(convert(CStr(val(I + 1)), I)) + " "
End If
Next I

't = Trim(convert(CStr(val(4)), 3) + " " + _
'         convert(CStr(val(3)), 2) + " " + _
'         convert(CStr(val(2)), 1) + " " + _
'         convert(CStr(val(1)), 0))

    '>>Cnvertir des nombres à 3 chiffres en lettres
'>>--------------------------------------------
lon = Len(t)
CT = UCase(Left(t, 1)) + Right(t, (lon - 1))
If (unite = "") Then
enLettres = Trim(CT)
Else
enLettres = Trim(CT) & " " & unite
End If
'>>------------------------------------------------
End Function

'>>Conertit un chiffre en lettre: sans unités
'>>1000 -> Mille
'>>2000 -> Milles
Public Function convertNumber(Nombre As Double) As String
'>>------------------------------------------------
Dim CT As String, lon As Integer, enLettre As String
Dim t As String

'>>Cnvertir des nombres à 3 chiffres en lettres
'>>--------------------------------------------
t = Trim(enLettres(Nombre))
'>>--------------------------------------------
'>>
'>>--------------------------------------------
lon = Len(t)
enLettre = UCase(Left(t, 1)) + Right(t, (lon - 1))
enLettre = enLettres(Nombre)
C = UCase(Trim(enLettre))

'>>si le nombre net finit pas par "Cent", "mille", "million", "milliard"
If ((Right(C, 4) <> "CENT") And (Right(C, 5) <> "MILLE") And _
(Right(C, 7) <> "MILLION") And (Right(C, <> "MILLIARD")) Then
U = enLettre
End If

'>>si le nombre finit par "Cent", "mille", "un million", "un milliard"
If ((Trim(C) = "CENT") Or (Trim(C) = "MILLE") Or _
(Trim(C) = "UN MILLION") Or (Trim(C) = "UN MILLIARD")) Then
U = enLettre
'>>si le nombre finit par "Cent", "mille", "million", "milliard"
ElseIf ((Trim(C) <> "CENT") And (Trim(C) <> "MILLE") And _
(Trim(C) <> "UN MILLION") And (Trim(C) <> "UN MILLIARD")) Then
If (Right(C, 4) = "CENT") Then
U = enLettre + "s"
ElseIf (Right(C, 5) = "MILLE") Then
U = enLettre + "s"
ElseIf (Right(C, 7) = "MILLION") Then
U = enLettre + "s"
ElseIf (Right(C, = "MILLIARD") Then
U = enLettre + "s"
End If
End If
convertNumber = U
'>>------------------------------------------------
End Function

Private Function convert(Ti As String, I As Integer) As String
'>>------------------------------------------------
Dim t As String ', C As String, U As String

'U = Right(Ti, 2) '>> nombre à 3 chiffres: 125 -> 25
'C = Left(Ti, 1)  '>> nombre à 1 chiffre: 125->1
t = Trim(getTextUnite(Ti, I))
convert = t
'>>------------------------------------------------
End Function

Private Function getTextUnite(Ti As String, I As Integer) As String
'>>------------------------------------------------
Dim U As Integer, C As Integer, t As String

U = CInt(Right(Ti, 2))  '>> nombre à 3 chiffres: 125 -> 25
C = CInt(Left(Ti, 1))   '>> nombre à 1 chiffre: 125->1
'----------
If (I = 0) Then
t = getTextNu(Ti)
ElseIf ((I = 1)) Then
If ((C = 0) And (U = 0)) Then
t = getTextNu(Ti)
ElseIf ((C = 0) And (U = 1)) Then
t = "mille"
Else
t = getTextNu(Ti) + " mille"
End If
ElseIf (I = 2) Then
If ((C = 0) And (U = 0)) Then
t = getTextNu(Ti)
Else
t = getTextNu(Ti) + " million"
End If
ElseIf (I = 3) Then
If ((C = 0) And (U = 0)) Then
t = getTextNu(Ti)
Else
t = getTextNu(Ti) + " milliard"
End If
End If
getTextUnite = Trim(t)
'>>------------------------------------------------
End Function

Private Function getTextNu(Ti As String) As String
'>>------------------------------------------------
Dim U As String, C As String, t As String

U = Right(Ti, 2) '>> nombre à 3 chiffres: 125 -> 25
C = Left(Ti, 1)  '>> nombre à 1 chiffre: 125->1

If ((CInt(C) = 0) And (CInt(U) = 0)) Then
t = ""
ElseIf ((CInt(C) = 0) And (CInt(U) <> 0)) Then
t = getNombre99(U)
ElseIf ((CInt(C) <> 0) And (CInt(U) = 0)) Then
t = getC(C)
ElseIf ((CInt(C) <> 0) And (CInt(U) <> 0)) Then
t = getC(C) & " " & getNombre99(U)
End If
getTextNu = Trim(t)
'>>------------------------------------------------
End Function

Private Function getC(C As String) As String
'>>------------------------------------------------
Dim t As String

Select Case (CInt(C))
Case 0: t = ""
Case 1: t = "cent"
Case 2: t = "deux cent"
Case 3: t = "trois cent"
Case 4: t = "quatre cent"
Case 5: t = "cinq cent"
Case 6: t = "six cent"
Case 7: t = "sept cent"
Case 8: t = "huit cent"
Case 9: t = "neuf cent"
End Select
getC = Trim(t)
'>>------------------------------------------------
End Function

Private Function getNombre99(U As String) As String
‘>>--------------------------------------------------------------
Dim t As String
Select Case (CInt(U))
Case 1: t = "un"
Case 2: t = "deux"
Case 3: t = "trois"
Case 4: t = "quatre"
Case 5: t = "cinq"
Case 6: t = "six"
Case 7: t = "sept"
Case 8: t = "huit"
Case 9: t = "neuf"
'>>---------------
Case 10: t = "dix"
Case 11: t = "onze"
Case 12: t = "douze"
Case 13: t = "treize"
Case 14: t = "quatorze"
Case 15: t = "quinze"
Case 16: t = "seize"
Case 17: t = "dix sept"
Case 18: t = "dix huit"
Case 19: t = "dix neuf"
'>>---------------
Case 20: t = "vingt"
Case 21: t = "vingt un"
Case 22: t = "vingt deux"
Case 23: t = "vingt trois"
Case 24: t = "vingt quatre"
Case 25: t = "vingt cinq"
Case 26: t = "vingt six"
Case 27: t = "vingt sept"
Case 28: t = "vingt huit"
Case 29: t = "vingt neuf"
'>>---------------
Case 30: t = "trente"
Case 31: t = "trente un"
Case 32: t = "trente deux"
Case 33: t = "trente trois"
Case 34: t = "trente quatre"
Case 35: t = "trente cinq"
Case 36: t = "trente six"
Case 37: t = "trente sept"
Case 38: t = "trente huit"
Case 39: t = "trente neuf"
'>>---------------
Case 40: t = "quarante"
Case 41: t = "quarante un"
Case 42: t = "quarante deux"
Case 43: t = "quarante trois"
Case 44: t = "quarante quatre"
Case 45: t = "quarante cinq"
Case 46: t = "quarante six"
Case 47: t = "quarante sept"
Case 48: t = "quarante huit"
Case 49: t = "quarante neuf"
'>>---------------
Case 50: t = "cinquante"
Case 51: t = "cinquante un"
Case 52: t = "cinquante deux"
Case 53: t = "cinquante trois"
Case 54: t = "cinquante quatre"
Case 55: t = "cinquante cinq"
Case 56: t = "cinquante six"
Case 57: t = "cinquante sept"
Case 58: t = "cinquante huit"
Case 59: t = "cinquante neuf"
'>>---------------
Case 60: t = "soixante"
Case 61: t = "soixante un"
Case 62: t = "soixante deux"
Case 63: t = "soixante trois"
Case 64: t = "soixante quatre"
Case 65: t = "soixante cinq"
Case 66: t = "soixante six"
Case 67: t = "soixante sept"
Case 68: t = "soixante huit"
Case 69: t = "soixante neuf"
'>>---------------
Case 70: t = "soixante dix"
Case 71: t = "soixante onze"
Case 72: t = "soixante douze"
Case 73: t = "soixante treize"
Case 74: t = "soixante quatorze"
Case 75: t = "soixante quinze"
Case 76: t = "soixante seize"
Case 77: t = "soixante dix sept"
Case 78: t = "soixante dix huit"
Case 79: t = "soixante dix neuf"
'>>---------------
Case 80: t = "quatre vingt"
Case 81: t = "quatre vingt un"
Case 82: t = "quatre vingt deux"
Case 83: t = "quatre vingt trois"
Case 84: t = "quatre vingt quatre"
Case 85: t = "quatre vingt cinq"
Case 86: t = "quatre vingt six"
Case 87: t = "quatre vingt sept"
Case 88: t = "quatre vingt huit"
Case 89: t = "quatre vingt neuf"
'>>---------------
Case 90: t = "quatre vingt dix"
Case 91: t = "quatre vingt onze"
Case 92: t = "quatre vingt douze"
Case 93: t = "quatre vingt treize"
Case 94: t = "quatre vingt quatorze"
Case 95: t = "quatre vingt quinze"
Case 96: t = "quatre vingt seize"
Case 97: t = "quatre vingt dix sept"
Case 98: t = "quatre vingt dix huit"
Case 99: t = "quatre vingt dix neuf"
End Select
getNombre99 = Trim(t)
End Function