Cette fonction permet de traduire une valeur numérique en une chaîne texte qui représente l'expression française du montant. La devise est un paramètre de la fonction.
Par exemple :
>>> m_ÉcritMontant(201.55,"euro","centime")
retourne
>>> "Deux cent un euros et cinquante-cinq centimes"
Voilà, c'est surtout utile pour les impressions de chèques.
Enjoy,
Source / Exemple :
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
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.