Soyez le premier à donner votre avis sur cette source.
Vue 50 907 fois - Téléchargée 2 433 fois
' 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
13 août 2009 à 20:12
19 avril 2009 à 03:14
2 juin 2007 à 20:03
2 juin 2007 à 20:01
Soit à convertir 123,456. Et biens tu fais la conversion de la partie entière (123), puis de la partie décimale (456) et tu concatènes. Et bien sur tu vires de la routine les "cent" ou "euros" ou je ne sais quoi qui n'ont de toute façon rien à faire la. Il ne faut pas mélanger les genres.
2 juin 2007 à 19:21
mais si on a besoin de 3 chiffre après la virgule , comme faire ,
car il ya dans d'autre pays il y a 3 chiffre après la virgule
Merci
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.