/ Published in: Visual Basic
convert numbers to text (french) V1
Expand |
Embed | Plain Text
Copy this code and paste it in your HTML
' ***************************************************************************** ' ConvertitLettres ' ***************************************************************************** Public Function ConvertitLettres(Nombre,ChMonnaie) Dim NomUnites Dim valeurs Dim chaine dim sVar 'tableau((billion,milliard,million,millier,unité,décimale),(centaine,dizaine,unité)) Dim strT ' lettres de chaque chiffre selon emplacement Dim intD ' indicateur si chiffre avant, règle grammaticale (DEUX CENTS, DEUX CENT CINQ) Dim intT ' chiffre selon emplacement Dim b ' pour les boucle de traitement Dim d ' indicateur de décimale Dim Dizaine Dim ln Dim Presence Dim LeTiret Dim LaRetenue Dim Resultat ReDim NomUnites(90) ReDim valeurs(5) ReDim chaine(5) 'tableau((billion,milliard,million,millier,unité,décimale),(centaine,dizaine,unité)) ReDim strT(5, 2) ' lettres de chaque chiffre selon emplacement ReDim intD(5, 2) ' indicateur si chiffre avant, règle grammaticale (DEUX CENTS, DEUX CENT CINQ) ReDim intT(5, 2) ' chiffre selon emplacement ReDim Presence(5) ' 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 NomUnites NomUnites(0) = "zéro" NomUnites(1) = "un" NomUnites(2) = "deux" NomUnites(3) = "trois" NomUnites(4) = "quatre" NomUnites(5) = "cinq" NomUnites(6) = "six" NomUnites(7) = "sept" NomUnites(8) = "huit" NomUnites(9) = "neuf" ' Initialisation des termes de la dizaine NomUnites(10) = "dix" NomUnites(11) = "onze" NomUnites(12) = "douze" NomUnites(13) = "treize" NomUnites(14) = "quatorze" NomUnites(15) = "quinze" NomUnites(16) = "seize" NomUnites(17) = "dix-sept" NomUnites(18) = "dix-huit" NomUnites(19) = "dix-neuf" ' Initialisation des termes de dizaines NomUnites(20) = "vingt" NomUnites(30) = "trente" NomUnites(40) = "quarante" NomUnites(50) = "cinquante" NomUnites(60) = "soixante" NomUnites(70) = "soixante" NomUnites(80) = "quatre-vingt" NomUnites(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 intT(b \ 3, b Mod 3) <> 0 then sVar = b + 1 else sVar = intD(b \ 3, b Mod 3) end if If (b <> ln - 1) And b > 3 Then intD((b + 1) \ 3, (b + 1) Mod 3) = sVar 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 Presence(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 if intD(b, 2) <> 0 Then sVar = "" else sVar = "s" end if strT(b, 2) = NomUnites(intT(b, 2)) + " cent" + sVar 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 if intT(b, 1) 8 And intD(b, 1) 0 then sVar = "s" else sVar = "" end if strT(b, 1) = NomUnites(intT(b, 1) * 10) + sVar 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) + " " + NomUnites(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 " + NomUnites(intT(b, 0) + LaRetenue * 10) Else strT(b, 0) = "-" + NomUnites(intT(b, 0) + LaRetenue * 10) End If ElseIf b <> 2 Then strT(b, 0) = NomUnites(intT(b, 0) + LaRetenue * 10) ElseIf intT(b, 0) <> 1 Then strT(b, 0) = " " + NomUnites(intT(b, 0) + LaRetenue * 10) End If End If ' concatenation des centaines, dizaines et unités et retrait des espaces inutiles if strT(b, 1) = "" then sVar = "" else sVar = " " end if chaine(b) = Trim(Trim(strT(b, 2)) + sVar + Trim(strT(b, 1))) if Left(strT(b, 0), 1) = "-" then sVar = "" else sVar = " " end if chaine(b) = trim(chaine(b) + sVar + Trim(strT(b, 0))) ' + IIf(Left(strT(b, 0), 1) = "-", "", " ") + ' ajout de la valeurs si > 1 et différent des Mille (invariable) if (Presence(b) > 1) And (b > 2) then 'IIf((Presence(b) > 1) And (b > 2), "s", "") sVar = "s" else sVar ="" end if chaine(b) = chaine(b) + valeurs(b) + sVar End If Next ' concatenation finale et retrait des espaces inutiles Resultat = chaine(5) For b = 4 To 1 Step -1 if chaine(b) <> "" then 'IIf(chaine(b) <> "", " ", "") sVar = " " else sVar = "" end if Resultat = Resultat + sVar + chaine(b) Next If Resultat "" Then Resultat "zéro" if INSTR(1,Nombre,",")>0 then if Mid(Nombre, INSTR(1,Nombre,",")+1)*1 > 1 then 'IIf(CDec(Mid(Nombre, 1, Len(Nombre) - 3)) > 1, "s", "") sVar = "s" else sVar = "" end if else sVar = "" end if If ChMonnaie True Then Resultat Resultat + " Euro" + sVar If chaine(0) <> "" Then Resultat = Resultat + " et " + chaine(0) if Presence(0) > 1 Then 'IIf(Presence(0) > 1, "s", "") sVar = "s" else sVar = "" end if If ChMonnaie True Then Resultat Resultat + " centime" + sVar End If ' Fin ConvertitLettres = Trim(UCase(Resultat)) End Function