VB6/.Net VBA Transformer chiffres en lettre

Plusieurs démo du même style sont disponibles mais d'après ce que je constate sont toutes, soit limitée, soit ne respecte pas fidèlement la syntaxe

Introduction

Remerciements tout particulier à Patrice33740 pour sa participation à la syntaxe des nombres de la langue française.
.
Cette démo transforme un nombre en lettres jusque 999 Billiard 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.

Dans Module Fonction

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      
        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

Dans Module Initialisation

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

Téléchargement

Classeur Excel 97 - 03
Serveur 1 : Nombre_en_lettre_2000.xls

Classeur Excel 2007 et >
Serveur 1 : Nombre_en_lettre.xlsm

Macro complémentaire Excel 97 - 03 (mode d'emploi inclus)
Serveur 1 : Macro_complementaire_XL_97_-_03.zip

Macro complémentaire, Excel 2007 et > (mode d'emploi inclus)
Serveur 1 : Macro_complementaire_XL_2007.zip

Projet VB6
Serveur 1 : VB6_Nombre_en_lettre.zip

Projet VB.2010
Serveur 1 : Projet_VB_2010_Nombre_en_lettre.zip Ce document intitulé « VB6/.Net VBA Transformer chiffres en lettre » issu de CommentCaMarche (www.commentcamarche.net) est mis à disposition sous les termes de la licence Creative Commons. Vous pouvez copier, modifier des copies de cette page, dans les conditions fixées par la licence, tant que cette note apparaît clairement.