Ecrire des nombres en toutes lettres (multi-language)

Soyez le premier à donner votre avis sur cette source.

Vue 40 113 fois - Téléchargée 744 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"

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

Ajouter un commentaire Commentaires
Messages postés
12
Date d'inscription
lundi 16 mai 2005
Statut
Membre
Dernière intervention
20 février 2006

lol

En fait, comme j'ai développé une appli (www.immoassist.com) (tu peux aller la voir, même télécharger) pour toutes les langues, (complètement multi langue), et qu'elle doit écrire en toute lettre des montants ds les différentes langues, les langues actuellement supportée sont gérées par les routines que j'ai posté.

En cherchant, je n'avais rien trouvé d'existant, d'où mon idée de coder pour chaque langue.
Messages postés
91
Date d'inscription
jeudi 18 novembre 2004
Statut
Membre
Dernière intervention
17 décembre 2008

un belge ! je me disais aussi, c'est pas tres courant pour un francais de parler hollandais...
Messages postés
12
Date d'inscription
lundi 16 mai 2005
Statut
Membre
Dernière intervention
20 février 2006

geen, niet jen lol

Hablo tambien espagnol

I speak also English

NB : Il faut pas aussi oublier pour le français, il y a le "belge" et le suisse....

ici en Belgique, on ne dit pas soixante-dix, mais septante.....
Messages postés
91
Date d'inscription
jeudi 18 novembre 2004
Statut
Membre
Dernière intervention
17 décembre 2008

thank you ImmoAssist !
parce que "ik sprek jen nederland"
Messages postés
12
Date d'inscription
lundi 16 mai 2005
Statut
Membre
Dernière intervention
20 février 2006

Santiag,
inspires-toi du mien, aussi pour le néerlandais entre autre
Afficher les 15 commentaires

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.