Ecrire des nombres en toutes lettres (multi-language)
Soyez le premier à donner votre avis sur cette source.
Vue 40 329 fois - Téléchargée 756 fois
Description
ce code permet de transformer un nombre (double) en son interpretation en toutes lettres (string).
on peut ajouter des unites principales (euros, kilos, patates) et decimales (centimes, grammes, etc).
une section "dictionary" permet de parametrer le module afin qu'il interprete les nombres dans differentes langues (mais ca ne marche que dans une certaine limite et en tout cas pas pour l'allemand).
exemples d'utilisation :
NumberToWords(-12.583) = "MOINS DOUZE VIRGULE CINQ CENT QUATRE-VINGT TROIS"
NumberToWords(362.43, "euro", "cent") = "TROIS CENT SOIXANTE DEUX EURO QUARANTE TROIS CENT"
NumberToWords(73.5, "kilo") = "SOIXANTE TREIZE VIRGULE CINQ KILO"
je vous le dis tout de suite, y'a des fautes :
pour l'instant, la fonction ne gere pas le "et" de "vingt et un" ou "trente et un" ;
elle ne gere pas non plus les "-" comme dans "vingt-deux" (parait il qu'il y en a) ;
elle ne connait pas les pluriel "un euro" ou "douze euro".
voila, si vous trouvez des bugs autres que ceux-la sur lesquels je travaille, ca m'interesse.
on peut ajouter des unites principales (euros, kilos, patates) et decimales (centimes, grammes, etc).
une section "dictionary" permet de parametrer le module afin qu'il interprete les nombres dans differentes langues (mais ca ne marche que dans une certaine limite et en tout cas pas pour l'allemand).
exemples d'utilisation :
NumberToWords(-12.583) = "MOINS DOUZE VIRGULE CINQ CENT QUATRE-VINGT TROIS"
NumberToWords(362.43, "euro", "cent") = "TROIS CENT SOIXANTE DEUX EURO QUARANTE TROIS CENT"
NumberToWords(73.5, "kilo") = "SOIXANTE TREIZE VIRGULE CINQ KILO"
Source / Exemple :
'---------------------------- PROPERTIES ----------------------------'
'Author = Santiago Diez
'Date = 27 AUGUST 2005 16:54
'Version = 1.2
'--------------------------- DESCRIPTION ----------------------------'
'Convert any number (Double) in words (String) with the ability to add
'units (like Euros or potatoes) and decimal units (like Cents). Easyly
'adapt to any language by modifying the dictionary section.
'----------------- PUBLIC PROCEDURES AND FUNCTIONS ------------------'
'String = NumberToWords(Number As Double, [MainUnit], [DecUnit])
'------------------------- CALLED LIBRARIES -------------------------'
'msvbvm60.dll
'VB6.OLB
'VB6FR.DLL
'----------------------------- OPTIONS ------------------------------'
Option Explicit
Option Base 1
'+----------------------------------------------------------------------+'
'+ DICTIONARY +'
'+----------------------------------------------------------------------+'
Private Const KWMinus As String = "moins" 'How do you say minus ?
Private Const KWZero As String = "zéro" 'How do you say zero ?
Private Const KWDot As String = "virgule" 'How do you say dot ?
Private Const KWAnd As String = "et" 'How do you say and ?
Private Const KWHundred As String = "cent" 'How do you say hundred ?
Private Const KWThousand As String = "mille" 'How do you say thousand ?
Private Const KWMillions As String = "million" 'How do you say million ?
Private Const KWBillions As String = "milliard" 'How do you say billion ?
Private Function KWOnes(N As Byte) As String
'How do you say one, two, three, four, five, six, seven, height... ?
KWOnes = Array("un", "deux", "trois", "quatre", "cinq", "six", _
"sept", "huit", "neuf")(N)
End Function
Private Function KWTens(N As Byte) As String
'How do you say ten, twenty, thrirty, fourty, fivty, sixty... ?
KWTens = Array("dix", "vingt", "trente", "quarante", "cinquante", _
"soixante", "soixante-dix", "quatre-vingt", "quatre-vingt-dix")(N)
End Function
Private Function KWSpecialNumbers(Number As Double) As String
'How do you say numbers that do not fit usual rules ?
Select Case Number
Case 11: KWSpecialNumbers = "onze"
Case 12: KWSpecialNumbers = "douze"
Case 13: KWSpecialNumbers = "treize"
Case 14: KWSpecialNumbers = "quatorze"
Case 15: KWSpecialNumbers = "quinze"
Case 16: KWSpecialNumbers = "seize"
End Select
End Function
Private Function KWUseOne(Unit As String) As Boolean
'Do you say "one" before the folowing units ?
Select Case Unit
Case KWHundred: KWUseOne = False
Case KWThousand: KWUseOne = False
Case KWMillions: KWUseOne = True
Case KWBillions: KWUseOne = True
End Select
End Function
'+----------------------------------------------------------------------+'
'+ MAIN FUNCTION +'
'+----------------------------------------------------------------------+'
'This function handles the minus numbers and splits a number in integer _
and decimal parts.
Public Function NumberToWords(ByVal Number As Double, Optional ByVal _
MainUnit, Optional ByVal DecUnit) As String
'Case Number is negative.
If (Number < 0) Then
NumberToWords = (KWMinus & " " & NumberToWords(-Number, MainUnit _
, DecUnit))
'General case.
Else
NumberToWords = UnitsToWords(Int(Number), Dec(Number), MainUnit, _
DecUnit)
End If
End Function
'This function compose an ordered sentence with integer part, decimal _
part, units and subunits.
Private Function UnitsToWords(IntPart As Double, DecPart As Double, _
Optional MainUnit, Optional DecUnit) As String
If IsMissing(MainUnit) Then
UnitsToWords = UnitsToWords(IntPart, DecPart, "", DecUnit)
ElseIf IsMissing(DecUnit) Then
UnitsToWords = UnitsToWords(IntPart, DecPart, MainUnit, "")
Else
UnitsToWords = Trim( _
IIf((IntPart > 0) Or (DecUnit = ""), _
IntToWords(IntPart) & _
IIf((DecUnit = ""), "", " " & CStr(MainUnit)), "") & _
IIf(DecPart > 0, _
IIf((DecUnit = ""), " " & KWDot, "") & _
" " & IntToWords(DecPart) & _
IIf((DecUnit = ""), "", " " & CStr(DecUnit)), "") & _
IIf((MainUnit <> "") And (DecUnit = ""), _
" " & CStr(MainUnit), ""))
End If
End Function
'This function transforms a positive integer number into words.
Private Function IntToWords(Number As Double) As String
'Case Number = 0.
If (Number = 0) Then
IntToWords = KWZero
'Case Number is a special number.
ElseIf (KWSpecialNumbers(Number) <> "") Then
IntToWords = KWSpecialNumbers(Number)
'Case Number is greater than a billion.
ElseIf (Len(CStr(Number)) > 9) Then
IntToWords = SplitNumber(Number, 9, KWBillions)
'Case Number is between a million and a billion.
ElseIf (Len(CStr(Number)) > 6) Then
IntToWords = SplitNumber(Number, 6, KWMillions)
'Case Number is between a thousand and a million.
ElseIf (Len(CStr(Number)) > 3) Then
IntToWords = SplitNumber(Number, 3, KWThousand)
'Case Number is between a hundred and a thousand.
ElseIf (Len(CStr(Number)) > 2) Then
IntToWords = SplitNumber(Number, 2, KWHundred)
'Case Number is between ten and a hundred.
ElseIf (Len(CStr(Number)) > 1) Then
IntToWords = (KWTens(CByte(LeftPart(Number, 1))) & _
RightPartToWords(RightPart(Number, 1)))
'Case Number is lesser than ten.
Else
IntToWords = KWOnes(CByte(Number))
End If
End Function
'+----------------------------------------------------------------------+'
'+ OTHER FUNCTIONS +'
'+----------------------------------------------------------------------+'
Private Function SplitNumber(Number As Double, CutPos As Byte, CutWord _
As String) As String
SplitNumber = (LeftPartToWords(LeftPart(Number, CutPos), CutWord) & _
CutWord & _
RightPartToWords(RightPart(Number, CutPos)))
End Function
Private Function LeftPartToWords(Number As Double, CutWord As String) As _
String
If ((Number > 1) Or KWUseOne(CutWord)) _
Then LeftPartToWords = (IntToWords(Number) & " ")
End Function
Private Function LeftPart(Number As Double, CutPos As Byte) As Double
LeftPart = CDbl(Left(CStr(Number), Len(CStr(Number)) - CutPos))
End Function
Private Function RightPartToWords(Number As Double) As String
If (Number > 0) Then RightPartToWords = (" " & IntToWords(Number))
End Function
Private Function RightPart(Number As Double, CutPos As Byte) As Double
RightPart = CDbl(Right(CStr(Number), CutPos))
End Function
'+----------------------------------------------------------------------+'
'+ MATH FUNCTIONS +'
'+----------------------------------------------------------------------+'
'Returns the decimal part of a double as an integer value (e.g. _
Dec(46.514) returns 514).
Private Function Dec(Value As Double) As Double
Dec = CDbl(DecString(CStr(Value)))
End Function
Private Function DecString(Value As String) As String
DecString = "0"
On Error Resume Next
If (InStr(1, Value, ".", vbTextCompare) > 0) Then _
DecString = Mid(Value, InStr(1, Value, ".", vbTextCompare) + 1)
End Function
Conclusion :
je vous le dis tout de suite, y'a des fautes :
pour l'instant, la fonction ne gere pas le "et" de "vingt et un" ou "trente et un" ;
elle ne gere pas non plus les "-" comme dans "vingt-deux" (parait il qu'il y en a) ;
elle ne connait pas les pluriel "un euro" ou "douze euro".
voila, si vous trouvez des bugs autres que ceux-la sur lesquels je travaille, ca m'interesse.
Codes Sources
A voir également
- Ecrire des nombres en toutes lettres (multi-language)
- Rang des lettres de l'alphabet - Forum Visual Basic
- Vba ecrire dans un fichier - Conseils pratiques -Visual Basic / VB.NET
- Montant en lettres - Forum Delphi / Pascal
- Ecrire en ligne - Forum Java
- Position des lettres dans l'alphabet ✓ - Forum Visual Basic
27 août 2005 à 20:55
Cette source est vraiment excellente. Cela faisait très longtemps que je cherchait cela (pour une appication de compta et écriture de chèques...) et je n'avais rien trouvé sur le web.
Je me repete, mais vraiment ; BRAVO !!
28 août 2005 à 08:03
En effet, cette source est excellente. Pour l'emploi du trait d'union, en fait on ne le met que pour des valeurs inférieure à la centaine : quatre-vingt-douze ou cent cinquante-quatre, et non pas par exemple cent-deux qui est faux (on écrit cent deux).
Un autre problème est posé par vingt et cent. On écrit deux cents (avec un s !!) et quatre-vingts. Les puristes préciseraient que l'on écrit "quatre-vingts feuilles" (quantité) mais "page quatre-vingt" (i.e. la quatre-vingtième page).
Voilà pour les quelques précisions. Encore bravo !
Cordialement,
Cacophrène
28 août 2005 à 10:07
Sympa comme idée de source je jetterai un coup d'oeil aujourd'hui !!! Pour le pluriel de euro en tout cas c'est pas bien grave car je crois que normalement, euro est invariable et ne prend pas de S : en effet, si on avait décidé de mettr un S a euro au pluriel, dans d'autres pays on aurait parlé de 120 euri ou je ne sais quoi...
Voila voila, bien cordialement,
PierreAd
28 août 2005 à 10:40
@+
28 août 2005 à 14:44
Euh... PierreAd en français euro est variable. Il est invariable dans d'autres langues.
Cordialement,
Cacophrène
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.