![]() |
|
Forum
|
|
|
#2 (permalink) |
|
Messages: n/a
|
Salut"banfai116" ici un lien que j'ai trouvé via la rubrique "RECHERCHE " du "FORUM", là haut j'ai tapé "Chiffres en Lettres" <http://www.excel-downloads.com/html/French/forum/search.php?f=1&search=chiffres+en+lettres&globalse arch=0&match=1&date=0&fldsubject=1> A+++ Jean Marie |
|
|
#3 (permalink) |
|
Messages: n/a
|
Réponse
Function lireCentaine(ByVal Montant As Double) As String Dim ChiffreLettre Dim Centaine As Double Dim Dizaine As Double Dim T As String Dim Chaine As String ChiffreLettre = Array("un", "deux", "trois", "quatre", "cinq", "six", _ "sept", "huit", "neuf", "dix", _ "onze", "douze", "treize", "quatorze", "quinze", _ "seize", "dix-sept", "dix-huit", "dix-neuf") Centaine = Int(Montant / 100) Select Case Centaine Case 0 Chaine = "" Case 1 Chaine = "cent" Case Else Chaine = ChiffreLettre(Centaine - 1) & " cent" End Select Dizaine = Modulo(Montant, 100) Select Case Dizaine Case 0 T = "" Case 1 To 19 T = ChiffreLettre(Dizaine - 1) Case 20 T = "vingt" Case 21 T = "vingt et un" Case 22 To 29 T = "vingt " & ChiffreLettre(Dizaine - 21) Case 30 T = "trente" Case 31 T = "trente et un" Case 32 To 39 T = "trente-" & ChiffreLettre(Dizaine - 31) Case 40 T = "quarante" Case 41 T = "quarante et un" Case 42 To 49 T = "quarante-" & ChiffreLettre(Dizaine - 41) Case 50 T = "cinquante" Case 51 T = "cinquante et un" Case 52 To 59 T = "cinquante-" & ChiffreLettre(Dizaine - 51) Case 60 T = "soixante" Case 61 T = "soixante et un" Case 62 To 69 T = "soixante-" & ChiffreLettre(Dizaine - 61) Case 70 T = "soixante-dix" Case 71 T = "soixante et onze" Case 72 To 79 T = "soixante-" & ChiffreLettre(Dizaine - 61) Case 80 T = "quatre-vingts" Case 81 To 89 T = "quatre-vingt " & ChiffreLettre(Dizaine - 81) Case 90 To 99 T = "quatre-vingt " & ChiffreLettre(Dizaine - 81) Case Else T = "Erreur de conversion !" End Select If (Chaine & " " & T) = " " Then lireCentaine = "" Else lireCentaine = LTrim(Chaine & " ") & T End If End Function Function Modulo(ByVal Nombre As Double, ByVal Diviseur As Double) As Double Modulo = Nombre - (Diviseur * Int(Nombre / Diviseur)) End Function Function Arrondir(ByVal ValeurArrondi As Double, ByVal NbreDeci As Integer) As Double Arrondir = ValeurArrondi + (5 * 10 ^ -(NbreDeci + 1)) Arrondir = Int(Arrondir * 10 ^ NbreDeci) / 10 ^ NbreDeci End Function Function NbreLettres(ByVal Total As Double) As String Dim Millions As Double Dim Milliers As Double Dim cent As Double Dim decimales As Double Dim T0 As String Dim T1 As String Dim T2 As String Dim T3 As String Dim Resultat As String Dim T As String Dim S1, S2 As String Total = Arrondir(Total, 2) Millions = Int(Modulo(Int(Total / 1000000), 1000)) Milliers = Int(Modulo(Int(Total / 1000), 1000)) cent = Int(Modulo(Total, 1000)) decimales = Arrondir((Modulo(Total * 100, 100)), 0) S1 = "" S2 = "" If cent <= 1 Then If Milliers < 1 Then Else S1 = "s" End If Else S1 = "s" End If If decimales <= 1 Then S2 = "" Else S2 = "s" T0 = lireCentaine(Millions) T1 = lireCentaine(Milliers) T2 = lireCentaine(cent) T3 = lireCentaine(decimales) If (T0 = "" And T1 = "" And T3 = "" And Right(T2, 5) = "cent ") Then If cent > 100 Then T2 = RTrim(T2) & "s" End If If T0 <> "" Then Resultat = T0 & " millions " If T1 = "" And T2 = "" And T3 = "" Then Resultat = T0 & " millions d'euros" End If Else Resultat = "" End If If T1 <> "" Then If T1 = "un" Then T1 = "" End If Resultat = Resultat & T1 & " mille " Else Resultat = Resultat & "" End If If T2 <> "" Then Resultat = Resultat & T2 & " euros" Else If Resultat <> "" Then Resultat = Resultat End If End If If T3 <> "" Then If Resultat <> "" Then Resultat = Resultat & " et " & T3 & " centimes" Else Resultat = T3 End If End If NbreLettres = Resultat End Function Ceci répond-t-il à ta question ? |
| ANNONCES | |
| Outils de la discussion | |
|
|