|
Trouver une ressource
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
TRADUCTION D'UN MONTANT NUMÉRIQUE EN EXPRESSION LITTÉRALE
Information sur la source
Description
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
- 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
-
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
Sources du même auteur
Sources de la même categorie
Sources en rapport avec celle ci
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
Expression numérique [ par zelick ]
G 1 pb tout bete que je n'arrive pas à résoudre! Un utilisateur rentre une valeur numerique dans un InputBox avec le pave numerique, exemple : 0.1; il
Récupérer date création photo numérique [ par Seb_d_angers ]
J'aimerais récupérer la date et l'heure ou a été prise une photo numérique. En VB je peux récuperer la date du transfert (avec FileDateTime) mais ce n
Récup date création photo numérique [ par Seb_d_angers ]
*********************************J'espère t'avoir aiderA+Sebhttp://www.programmez.org
Je trouve pu un programme !!! De calcul et d'expression!!!!!!!! [ par ATH|500| ]
Voilà le programme que je cherche...Un programme qui traçait les lignes graphiques de différentes fontions comme Tan Sin Sin-1 etc. etc.. Mais je m'en
Format numérique pour une box [ par yannch ]
Bonjour, Je dois créer une combo box qui ne doit accepter que le format numérique.Merci d'avance pour vos conseils.(toutes vos propositions sont les b
Evaluation Expression [ par erreurs404 ]
Bonjour à tous,j'ai une série de fonctions du typemsg_user()msg_oper()msg_desc()etc ...ce que j'aimerais c'est pouvoir les lancer par l'évaluation d'u
HELP !!! Photo numérique [ par Seb_d_angers ]
Voial mon souci, je veux faire un prog pour renommer mes photos numérique en fonction de la date et l'heure du cliché, je sais les récupérer en ouvran
Format numérique d'une cellule excel [ par cuicui ]
BONJOUR A tous, jr voudrai savoir comment tester si une cellule excel est au format numériquemerci
SQL Expression Editor de Crystal Reports 9 [ par stageeditionsdoc ]
Je voudrais savoir quel genre d'expression SQL cet edieur acceptait. Un exemple serait le bienvenu.Merci.nico
expression reguliere en VB [ par wonesek ]
Bonjour tout le monde,je voulais savoir comment on manipulait les expressions regulieres en VB.je "viens" du VBS et l'objet regExp facilitait la tache
|
Téléchargements
Logiciels à télécharger sur le même thème :
Comparez les prix Nouvelle version
|