Soyez le premier à donner votre avis sur cette source.
Snippet vu 13 782 fois - Téléchargée 58 fois
Public Function m_ÉcritMontant(Montant As Currency, Optional Monnaie As String, Optional Centime As String) As String '--------------------------- 'skrol29@freesurf.fr 'Version 1.00, le 01/02/1999 'Version 1.02, le 12/05/2002 '--------------------------- Dim t1(20) As String Dim t2(9) As String Dim t3(6) As String Dim i As Integer Dim i_max As Integer Dim i_min As Integer Dim m As String 'Montant numérique sous forme de chaîne formatée "000" Dim r As Integer 'Reste de la longueur à cobler pour avoir un format "000" Dim p As String 'Partie au format "000" Dim p1 As Integer ' partie untié de P Dim p2 As Integer ' partie dizaine de P Dim p3 As Integer ' partie centaine de P Dim w As String 'Montant en lettre de P Dim x As String 'Montant en lettre final t1(0) = "" t1(1) = "un" t1(2) = "deux" t1(3) = "trois" t1(4) = "quatre" t1(5) = "cinq" t1(6) = "six" t1(7) = "sept" t1(8) = "huit" t1(9) = "neuf" t1(10) = "dix" t1(11) = "onze" t1(12) = "douze" t1(13) = "treize" t1(14) = "quatorze" t1(15) = "quinze" t1(16) = "seize" t1(17) = "dix-sept" t1(18) = "dix-huit" t1(19) = "dix-neuf" t1(20) = "vingt" t2(0) = "" t2(1) = "" t2(2) = "vingt" t2(3) = "trente" t2(4) = "quarante" t2(5) = "cinquante" t2(6) = "soixante" t2(7) = "soixante" t2(8) = "quatre-vingt" t2(9) = "quatre-vingt" If Monnaie = "" Then Centime = "" Else If Montant >= 2 Then Monnaie = Monnaie & "s" End If If Centime <> "" Then If ((Montant - Fix(Montant)) * 100) >= 2 Then Centime = Centime & "s" End If If ((Montant - Fix(Montant)) * 100) > 0 Then Monnaie = Monnaie & " et" End If End If End If t3(0) = Centime t3(1) = Monnaie t3(2) = "mille" t3(3) = "million" t3(4) = "milliard" t3(5) = "billiard" t3(6) = "triard" 'Mise en forme en chaîne m = Format$(Montant, "000.00") r = Len(m) Mod 3 If r > 0 Then m = Left$("000", 3 - r) & m End If i_max = (Len(m) / 3) - 1 i_min = IIf(Centime = "", 1, 0) x = "" For i = i_min To i_max p = Mid$(m, Len(m) - (3 * i) - 2, 3) p1 = Val(Mid$(p, 3, 1)) p2 = Val(Mid$(p, 2, 1)) p3 = Val(Mid$(p, 1, 1)) 'centaines Select Case p3 Case 0 w = "" Case 1 w = "cent" Case Else w = t1(p3) & IIf((p1 = 0) And (p2 = 0), " cents", " cent") End Select 'dizaines Select Case p2 Case 0, 1 'de 0 à 19 w = w & " " & t1(p1 + 10 * p2) Case 7, 9 'on passe aux valeur qui dépasssent 10 w = w & " " & t2(p2) & IIf((p1 = 1) And (p2 < 8), " et ", "-") & t1(p1 + 10) Case Else If (i <= 1) And (p2 = 8) And (p1 = 0) Then 'Cas ou le montant se termine par "Quatre-vingts" tout rond w = w & " " & t2(8) & "s" Else w = w & " " & t2(p2) & IIf((p1 = 1) And (p2 < 8), " et ", IIf(p1 = 0, "", "-")) & t1(p1) End If End Select w = Trim$(w) 'On affiche "zéro" si la somme fait "zéro euro" If (i > 0) And (Montant < 1) Then w = "zéro" End If If (w <> "") Or ((i = 1) And (i_max > 1)) Then If (i = 2) And (p = "001") Then 'On évite le "un" s'il s'agit d'1 millier d'euro (exemple : "mille deux cents", et non pas "un mille deux cent") x = t3(i) & " " & x Else 'dans le cas classique, on colle la somme x = w & " " & t3(i) & " " & x End If End If x = Trim$(x) Next i m_ÉcritMontant = UCase$(Left$(x, 1)) & Mid$(x, 2) End Function
http://www.vbfrance.com/article.aspx?Val=3783
voila et bravo pour ce code, car il faut etre franc je cros qu'il est meiux que le miens ...
a+
Tu fais m_ÉcritMontant(201.55,"dollar","cent")
Bon, après si les candiens utilisent n'écrivent ps les nombres de la même façon ben faut le dire. C'est possible, les belges disent 'septente' pour 'soixante-dix'.
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.