je sais qu'il en existe déjà plusieurs mais celui-ci n'utilise
qu'une boucle de traitement (centaine, dizaine et unité)
permet de convertir des nombres en lettres
de 0,01 à 999999999999999,99 (1 billiard - 0,01)
avec ou sans indicateur monétaire
p.s. : le séparateur de décimales est la virgule et non le point
si vous avez besoin de plus grand encore
vous n'avez qu'à redimensionner les tables
vous pouvez changer aussi l'indicateur monétaire selon votre pays
Source / Exemple :
' Renvoie un nombre sous forme de lettres ( 3581 devient TROIS MILLE CINQ CENT QUATRE-VINGT-UN)
Public Function ConvertitLettres2(Nombre As String) As String
Dim NomUnités(90) As String
Dim valeurs(5) As String, chaine(5) As String
'tableau((billion,milliard,million,millier,unité,décimale),(centaine,dizaine,unité))
Dim strT(5, 2) As String ' lettres de chaque chiffre selon emplacement
Dim intD(5, 2) As Integer ' indicateur si chiffre avant, règle grammaticale (DEUX CENTS, DEUX CENT CINQ)
Dim intT(5, 2) As Integer ' chiffre selon emplacement
Dim b As Integer ' pour les boucle de traitement
Dim d As Integer ' indicateur de décimale
Dim Dizaine As Integer, ln As Integer
Dim Présence(5) As Integer
Dim LeTiret As Boolean, LaRetenue As Integer
Dim Résultat As String
' Initialisation de valeurs
valeurs(5) = " billion"
valeurs(4) = " milliard"
valeurs(3) = " million"
valeurs(2) = " mille"
valeurs(1) = "" ' unité
valeurs(0) = "" ' décimale
' Initialisation des termes de NomUnités
NomUnités(0) = "zéro"
NomUnités(1) = "un"
NomUnités(2) = "deux"
NomUnités(3) = "trois"
NomUnités(4) = "quatre"
NomUnités(5) = "cinq"
NomUnités(6) = "six"
NomUnités(7) = "sept"
NomUnités(8) = "huit"
NomUnités(9) = "neuf"
' Initialisation des termes de la dizaine
NomUnités(10) = "dix"
NomUnités(11) = "onze"
NomUnités(12) = "douze"
NomUnités(13) = "treize"
NomUnités(14) = "quatorze"
NomUnités(15) = "quinze"
NomUnités(16) = "seize"
NomUnités(17) = "dix-sept"
NomUnités(18) = "dix-huit"
NomUnités(19) = "dix-neuf"
' Initialisation des termes de dizaines
NomUnités(20) = "vingt"
NomUnités(30) = "trente"
NomUnités(40) = "quarante"
NomUnités(50) = "cinquante"
NomUnités(60) = "soixante"
NomUnités(70) = "soixante"
NomUnités(80) = "quatre-vingt"
NomUnités(90) = "quatre-vingt"
' Classification du nombre en sous-unités
d = InStr(1, Nombre, ",") ' nombre entier ou avec décimale
If d Then
Nombre = Left(Nombre, d - 1) + "0" + Mid(Nombre, d + 1) ' remplace la virgule par zéro
If Len(Nombre) - d = 1 Then Nombre = Nombre + "0" 's'assure qu'il y a 2 décimales
If Len(Nombre) - d > 2 Then ' sinon on arrondit à 2 décimales
If Mid(Nombre, d + 3, 1) >= 5 Then
Nombre = Mid(Nombre, 1, d + 1) & (1 + Mid(Nombre, d + 2, 1))
Nombre = Mid(Nombre, 1, d + 2)
Else
Nombre = Mid(Nombre, 1, d + 2)
End If
End If
Else
Nombre = Nombre + "000" 'sinon on ajoute pour combler les décimales
End If
intD(0, 0) = 0
ln = Len(Nombre)
For b = 0 To ln - 1
intT(b \ 3, b Mod 3) = Mid(Nombre, ln - b, 1)
If (b <> ln - 1) And b > 3 Then intD((b + 1) \ 3, (b + 1) Mod 3) = IIf(intT(b \ 3, b Mod 3) <> 0, b + 1, intD(b \ 3, b Mod 3))
Next
' Recherche des termes adaptés à chaque sous-unité
For b = (ln \ 3 + ln Mod 3) - 1 To 0 Step -1
strT(b, 0) = ""
chaine(b) = ""
LeTiret = False
LaRetenue = 0
If intT(b, 2) * 100 + intT(b, 1) * 10 + intT(b, 0) <> 0 Then
' Activation du drapeau
Présence(b) = intT(b, 2) * 100 + intT(b, 1) * 10 + intT(b, 0)
' Nombre supérieur ou égal à 1
' Vérification si supérieur ou égale à 100
If intT(b, 2) >= 2 Then
strT(b, 2) = NomUnités(intT(b, 2)) + " cent" + IIf(intD(b, 2) <> 0, "", "s")
ElseIf intT(b, 2) = 1 Then
strT(b, 2) = "cent"
End If
Dizaine = intT(b, 1) * 10 + intT(b, 0)
' Vérification si supérieur à 20
If Dizaine >= 20 Then
strT(b, 1) = NomUnités(intT(b, 1) * 10) + IIf(intT(b, 1) = 8 And intD(b, 1) = 0, "s", "")
If Dizaine >= 60 Then
LaRetenue = ((Dizaine \ 10) - 6) Mod 2
End If
LeTiret = True
ElseIf Dizaine >= 10 And Dizaine <= 19 Then
strT(b, 1) = strT(b, 1) + " " + NomUnités(Dizaine)
End If
' Vérification si unité non-nul
If (intT(b, 0) > 0 And intT(b, 1) <> 1) Or LaRetenue Then 'Dizaine <> 1 Then
If LeTiret And intT(b, 1) <> 1 Then
If intT(b, 0) = 1 And intT(b, 1) < 8 Then
strT(b, 0) = " et " + NomUnités(intT(b, 0) + LaRetenue * 10)
Else
strT(b, 0) = "-" + NomUnités(intT(b, 0) + LaRetenue * 10)
End If
ElseIf b <> 2 Then
strT(b, 0) = NomUnités(intT(b, 0) + LaRetenue * 10)
ElseIf intT(b, 0) <> 1 Then strT(b, 0) = " " + NomUnités(intT(b, 0) + LaRetenue * 10)
End If
End If
' concatenation des centaines, dizaines et unités et retrait des espaces inutiles
chaine(b) = Trim(Trim(strT(b, 2)) + IIf(strT(b, 1) = "", "", " ") + Trim(strT(b, 1)) + IIf(Left(strT(b, 0), 1) = "-", "", " ") + Trim(strT(b, 0)))
' ajout de la valeurs si > 1 et différent des Mille (invariable)
chaine(b) = chaine(b) + valeurs(b) + IIf((Présence(b) > 1) And (b > 2), "s", "")
End If
Next
' concatenation finale et retrait des espaces inutiles
Résultat = chaine(5)
For b = 4 To 1 Step -1
Résultat = Résultat + IIf(chaine(b) <> "", " ", "") + chaine(b)
Next
If Résultat = "" Then Résultat = "zéro"
If ChMonnaie = vbChecked Then Résultat = Résultat + " dollar" + IIf(CDec(Mid(Nombre, 1, Len(Nombre) - 3)) > 1, "s", "")
If chaine(0) <> "" Then
Résultat = Résultat + " et " + chaine(0)
If ChMonnaie = vbChecked Then Résultat = Résultat + " cent" + IIf(Présence(0) > 1, "s", "")
End If
' Fin
ConvertitLettres2 = Trim$(UCase$(Résultat))
Text2 = ConvertitLettres2
End Function
Conclusion :
mise a jour 1
il y a vérification du nombre de décimales.
1 décimale alors on ajout un zéro
plus de 2 décimales; arrondissement (ex. : 3,12499 = 3,12 et 3.1250001 = 3.13
mise a jour 2 (à venir)
indicateurs (70,80,90) et de monnaie selon pays
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.