Nombre en lettres

Soyez le premier à donner votre avis sur cette source.

Vue 15 396 fois - Téléchargée 1 817 fois

Description

Plusieurs démo du même style sont disponibles mais je constate qu'elles sont toutes, soit limitée, soit ne respecte pas fidèlement la syntaxe.
Cette démo transforme un nombre en lettres jusque 999 Billions avec 2 décimales si une devise est sélectionnée, jusque 0.000000009 si pas de devise.
Respecte toutes les règles de la syntaxe de la langue française. (Jusqu'à infirmation de votre part)
Le code ci-dessous est dispo dans tout les VB. Donc pas d'exemple exploitable directement.
Le zip contient plusieurs répertoires distincts...

Un classeur démo, Classeur Excel 97 - 03
Si vous n'êtes pas membre club vous pouvez le Télécharger sur
http://www.archive-host.com/link/dc3fd768dd0efbd8cd489c274f861c609cda3e45.xls Nombre_en_lettre_2000.xls

Un classeur démo, Classeur Excel 2007 et >
Si vous n'êtes pas membre club vous pouvez le Télécharger sur
http://www.archive-host.com/link/8fe14cef97be2e262a84217a51ab0f00fe51cc1d.xlsm Nombre_en_lettre.xlsm]

Une macro complémentaire, Excel 97 ? 03 (mode d?emploi inclus)
Si vous n'êtes pas membre club vous pouvez le Télécharger sur
http://www.archive-host.com/link/a65c95deda01e5b041fe3a0caac7d1c8c2f8b803.zip Macro_complementaire_XL_97_-_03.zip

Une macro complémentaire, Excel 2007 et > (mode d?emploi inclus)
Si vous n'êtes pas membre club vous pouvez le Télécharger sur
http://www.archive-host.com/link/9c813375f1d91c8febabc8ca386074cd0f17a30a.zip Macro_complementaire_XL_2007.zip

Projet VB6 Nombre en lettre
Si vous n'êtes pas membre club vous pouvez le Télécharger sur
http://www.archive-host.com/link/6256e1fcc5b8b239670a0c482127ec0e67315bc0.zip VB6_Nombre_en_lettre.zip

Projet VB 2010 Nombre en lettre
Si vous n'êtes pas membre club vous pouvez le Télécharger sur
http://www.archive-host.com/link/449893239b374e9d1c703ce4fd949800f7004aa5.zip Projet_VB_2010_Nombre_en_lettre.zip

Source / Exemple :


'Module 1
Option Explicit
Public sep As String

Public Pays As Byte
Dim Decim As String, Stade As Integer
Dim strResultat(6) As String
Dim Reste As Single
Dim StrReste As String
Dim Devize As String
Public Unite(19) As String
Public Monnaie(7) As String
Public Dixaines(2 To 9) As String
Dim ValNb(6) As Double
Dim mStrTemp As String

Function EnTexte(Chiffre As Double, Optional Langue As Byte = 0, Optional Devise As Byte = 0, Optional Decimale As Byte = 0) As String
Dim i As Integer, txt As String
Dim strTemp As String
Dim a As String, Nombre As String, TB, P As String
    If Chiffre = 0 Then EnTexte = "Zéro": Exit Function
    Nombre = CStr(Chiffre)
    If Decimale = 0 Or Int(Chiffre) = Chiffre Then
        Nombre = Arrondi(Nombre, 0)
        Reste = 0
        If Int(Chiffre) = 0 And Reste = 0 Then EnTexte = "Zéro": Exit Function
    Else
        TB = Split(CStr(Chiffre), sep)
        Reste = TB(1) / 10 ^ Len(TB(1)) 'pour 2 décimales
        StrReste = TB(1) 'si pas de devise, met toutes les décimales
        If Chiffre < 1 Then
            strTemp = "Zéro "
            GoTo PasUnite
        End If
        Nombre = Int(Chiffre)
    End If
    Pays = Langue
    If Unite(1) = "" Then InitVar
    InitPays
reco:
    If Len(Nombre) / 3 <> Int(Len(Nombre) / 3) Then
        Nombre = "0" & Nombre
        GoTo reco
    End If
    Stade = (Len(Nombre) / 3)
    For i = 0 To Stade - 1
        txt = Mid(Nombre, (i * 3) + 1, 3)
        ValNb(i) = Val(txt)
        strResultat(i) = Centaine(txt)
    Next i
    i = 0
    If Stade > 4 Then 'Billiard
        If strResultat(i) <> "" Then
            strTemp = strTemp & VoirRegle(strResultat(i)) & IIf(ValNb(i) = 1, "Billiard ", "Billiards ")
        End If
        i = i + 1
    End If
    If Stade > 3 Then 'Milliard
        If strResultat(i) <> "" Then
            strTemp = strTemp & VoirRegle(strResultat(i)) & IIf(ValNb(i) = 1, "Milliard ", "Milliards ")
        End If
        i = i + 1
    End If
    If Stade > 2 Then 'Million
        If strResultat(i) <> "" Then
            strTemp = strTemp & VoirRegle(strResultat(i)) & IIf(ValNb(i) = 1, "Million ", "Millions ")
        End If
        i = i + 1
    End If
    If Stade > 1 Then 'millier
        If strResultat(i) <> "" Then
            If strResultat(i) = "un " Then
                strTemp = strTemp & "Mille "
            Else
                strTemp = strTemp & VoirRegle(strResultat(i)) & "Mille "
            End If
        End If
        i = i + 1
    End If
    If Stade > 0 Then 'les unités
        If strResultat(i) <> "" Then
            If strTemp <> "" And ValNb(i) < 100 And (Right(strResultat(i), 3) <> "un " Or Len(strResultat(i)) = 3) Then
            TB = Split(strTemp, " ")

            Select Case TB(UBound(TB) - 1)
            Case "Million", "Millions", "Milliard", "Milliards", "Billiard", "Billiards"
                strTemp = strTemp & "et "
            End Select
            End If
            strTemp = strTemp & VoirRegle(strResultat(i), False)
        End If
    End If
    TB = Split(strTemp, " ")
    Select Case TB(UBound(TB) - 1)
    Case "Million", "Millions", "Milliard", "Milliards", "Billiard", "Billiards"
        Select Case Devise
        Case 1, 3: strTemp = strTemp & "de "
        Case 2: strTemp = strTemp & "d'"
        End Select
    End Select
PasUnite:
    Select Case Devise
    Case Is > 0: strTemp = strTemp & Monnaie(Devise) & IIf(Nombre = 1, " ", "s ")
    End Select
    If Reste <> 0 And Decimale = 1 Then
        If Devise = 0 Then
            strTemp = strTemp & "Virgule "
            'Appel pour les décimales en base 3
            strTemp = strTemp & AprVirgule(StrReste)
        Else:
            strTemp = strTemp & " " & P
            Reste = Int(Reste * 1000) / 10
            ValNb(1) = Arrondi(Reste, 0)
            If ValNb(1) = 100 Then 'rectifie 100 centimes
                strTemp = EnTexte(Arrondi(Chiffre, 0), Pays, Devise, 0)
            Else
                txt = Right("00" & Trim(Str(ValNb(1))), 3)
                txt = Centaine(txt): txt = Trim(txt) & " "
                strTemp = strTemp & VoirRegle(txt)
                strTemp = strTemp & Monnaie(Devise + 4) & IIf(ValNb(1) = 1, "", "s")
            End If
        End If
    End If
    EnTexte = strTemp
End Function

Private Function AprVirgule(Nombre As String) As String
Dim i As Integer, txt As String, strTemp As String, N
    N = Array("Millième", "Millionnième", "Milliardième")
reco:
    If Len(Nombre) / 3 <> Int(Len(Nombre) / 3) Then
        Nombre = Nombre & "0"
        GoTo reco
    End If
    Stade = (Len(Nombre) / 3)
    If Stade > 3 Then Stade = 3
    For i = 0 To Stade - 1
        txt = Mid(Nombre, (i * 3) + 1, 3)
        ValNb(i) = Val(txt)
        strResultat(i) = Centaine(txt)
    Next i
    For i = 0 To Stade - 1
        If strResultat(i) <> "" Then
            strTemp = strTemp & VoirRegle(strResultat(i)) & N(i) & IIf(ValNb(i) > 1, "s ", " ")
        End If
    Next i
    AprVirgule = strTemp
End Function

Private Function Centaine(Nombre As String) As String
Dim i As Integer, e(3) As Integer, a As String
Dim strBuff As String
    For i = 3 To 1 Step -1
        e(i) = Val(Mid(Nombre, i, 1))
    Next i
    e(0) = Val(Right(Nombre, 2))
    
    If e(3) = 1 Then
        If Pays = 0 Then
            If e(2) <= 7 Then strBuff = "et un " Else strBuff = Unite(e(3))
        Else
            If e(2) <> 8 Then strBuff = "et un " Else strBuff = Unite(e(3))
        End If
    Else
        strBuff = Unite(e(3))
    End If
    If e(0) < 20 Then
        strBuff = Unite(e(0))
    ElseIf e(0) < 70 Or (e(0) > 79 And e(0) < 90) Or Pays <> 0 Then
        If e(3) > 0 And Left(strBuff, 2) <> "et" Then
            strBuff = Trim(Dixaines(e(2))) & "-" & LTrim(strBuff)
        ElseIf strBuff <> "" Then
            strBuff = Dixaines(e(2)) & strBuff
        Else
            strBuff = Dixaines(e(2))
        End If
    Else
        If e(0) > 89 Then i = 80 Else i = 60
        If e(3) = 1 And e(2) = 7 Then
            strBuff = RTrim(Dixaines(e(2) - 1)) & " " & "et onze "
        Else
            strBuff = RTrim(Dixaines(e(2) - 1)) & "-" & Unite(e(0) - i)
        End If
    End If
    
    'Centaine
    If e(1) = 1 Then
        strBuff = "cent " & strBuff
    ElseIf e(1) >= 1 Then
        If e(0) = 0 Then a = "cents " Else a = "cent "
        strBuff = Unite(e(1)) & "cent " & strBuff
    End If
    Centaine = strBuff
End Function
Private Function Arrondi(ByVal Nombre, ByVal Decimales)
      Arrondi = Int(Nombre * 10 ^ Decimales + 1 / 2) / 10 ^ Decimales
End Function

Private Function VoirRegle(V As String, Optional Stde As Boolean = True) As String
        If Right(V, 6) = "vingt " Then
            If Stde Then
                VoirRegle = V
            ElseIf Len(V) > 6 Then
                VoirRegle = RTrim(V) & "s "
            Else
                VoirRegle = V
            End If
        ElseIf Right(V, 4) = "ent " Then
            If Stde Then
                VoirRegle = V
            ElseIf Len(V) > 5 Then
                VoirRegle = RTrim(V) & "s "
            Else
                VoirRegle = V
            End If
        Else
            VoirRegle = V
        End If
End Function

'Module 2
Option Explicit

Public Sub InitVar()
Unite(0) = "":          Unite(1) = "un ":       Unite(2) = "deux ":     Unite(3) = "trois ":    Unite(4) = "quatre "
Unite(5) = "cinq ":     Unite(6) = "six ":      Unite(7) = "sept ":     Unite(8) = "huit ":     Unite(9) = "neuf "
Unite(10) = "dix ":     Unite(11) = "onze ":    Unite(12) = "douze ":   Unite(13) = "treize ":  Unite(14) = "quatorze "
Unite(15) = "quinze ":  Unite(16) = "seize ":   Unite(17) = "dix-sept ": Unite(18) = "dix-huit ": Unite(19) = "dix-neuf "

Dixaines(2) = "vingt ": Dixaines(3) = "trente ": Dixaines(4) = "quarante ": Dixaines(5) = "cinquante ": Dixaines(6) = "soixante "

Monnaie(0) = "": Monnaie(1) = "Dollar": Monnaie(2) = "Euro": Monnaie(3) = "Franc"
Monnaie(4) = "": Monnaie(5) = "Cent": Monnaie(6) = "Centime": Monnaie(7) = "Centime"
End Sub

Sub InitPays()
    Select Case Pays
    Case 0 'France
        Dixaines(7) = "soixante-dix "
        Dixaines(8) = "quatre-vingt "
        Dixaines(9) = "quatre-vingt-dix "
    Case 1 'Belge
        Dixaines(7) = "septante "
        Dixaines(8) = "quatre-vingt "
        Dixaines(9) = "nonante "
    Case 2 'suisse
        Dixaines(7) = "septante "
        Dixaines(8) = "huitante "
        Dixaines(9) = "nonante "
    End Select
End Sub

Conclusion :


Je pense que maintenant c'est complet.
Hésitez pas sur la critique.

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Bonsoir
comment puis-je ajouter d'autre monnaie que l'euro et le dollar (pound par exemple (£)) ?
Merci
microsophistic
Messages postés
3
Date d'inscription
lundi 3 décembre 2012
Statut
Membre
Dernière intervention
17 janvier 2013
-
Bonjour, j'utilise cette fonction dans access 2007 et j'ai regroupé les deux modules dans un seul mais je bute sur quelques petites erreurs d'orthographe en Français, votre aide serait la bienvenue:
les centaines avec vingt par exemple 220 deux cent vingt et non deux cent vingts ...
si par exemple 80 000 s'écrit bien quatre-vingt mille, par contre avec 80 millions ou 80 milliards vingt prend un "s"!
Ceci dit cette fonction est très bien.
Merci de votre réponse.
Cordialement.
cs_ShayW
Messages postés
3258
Date d'inscription
jeudi 26 novembre 2009
Statut
Membre
Dernière intervention
3 décembre 2019
46 -
Salut
avec la conversion
Sep = System.Convert.ToChar(Application.CurrentCulture.NumberFormat.NumberDecimalSeparator)
cs_lermite222
Messages postés
492
Date d'inscription
jeudi 5 avril 2007
Statut
Membre
Dernière intervention
2 juillet 2012
-
Re tous,
Pour info, en .Net trouver le séparateur décimale du PC

dim Sep As Char
Sep = Application.CurrentCulture.NumberFormat.NumberDecimalSeparator
A+
nathansecret
Messages postés
63
Date d'inscription
mardi 11 novembre 2008
Statut
Membre
Dernière intervention
31 octobre 2011
-
'Pas terrible les Goto...

'A la place d'écrire :

reco:
If Len(Nombre) / 3 <> Int(Len(Nombre) / 3) Then
Nombre = "0" & Nombre
GoTo reco
End If

'ecrivez :

While Len(Nombre) / 3 <> Int(Len(Nombre) / 3)
Nombre = "0" & Nombre
Wend

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.