VB6/.Net VBA Transformer chiffres en lettre

Septembre 2016


Plusieurs démos du même style sont disponibles, mais d'après ce que je constate elles sont toutes,
soit limitées, soit ne respectant pas fidèlement la syntaxe.



Introduction


Remerciements tout particuliers à Patrice33740 pour sa participation à la syntaxe des nombres de la langue française.

Cette démo transforme un nombre en lettres jusque 999 billiards, 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 disponible dans tous 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

A voir également :

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.