Convertir les nombres

Convertir les nombres en lettres

De nombreuses fonction de conversion littérale de nombres existent mais comportent souvent de grossières erreurs grammaticales. J'ai donc décidé de proposer l'adaptation par Gus du code de Joe Foster.

Function NombreVersTexte(ByVal N As Currency) As String
    Dim Unité As String
    Dim Buf As String
    Dim Frac As Currency
    Dim i As Integer
    Dim MChiffre(4) As Currency
    Dim Mlettre(4) As String

    MChiffre(1) = 1000@
    Mlettre(1) = "mille "
    MChiffre(2) = MChiffre(1) * MChiffre(1)
    Mlettre(2) = "million"
    MChiffre(3) = MChiffre(2) * MChiffre(1)
    Mlettre(3) = "milliard"
    MChiffre(4) = MChiffre(3) * MChiffre(1)
    Mlettre(4) = "billion"

    If (N < 0@) Then Buf = "moins " Else Buf = ""
    Frac = Abs(N - Fix(N))
    If (N < 0@ Or Frac <> 0@) Then N = Abs(Fix(N))
    If N = 0@ Then Buf = Buf & "zéro "
    If N <= 1 Then
        Unité = "euro"
    Else
        Unité = "euros"
    End If

    For i = 4 To 1 Step -1
        If (N >= MChiffre(i)) Then
            If (MChiffre(i) <> 1000) Then
                Buf = Buf & ConverDigit(Int(N / MChiffre(i))) & " " & Mlettre(i)
                If Int(N / MChiffre(i)) > 1 Then Buf = Buf & "s"
                N = N - Int(N / MChiffre(i)) * MChiffre(i)
                If (N >= 1@) Then
                    Buf = Buf & " "
                Else
                    'si compte rond ajouter d' devant l'unité
                    'ex : un million d'euros
                    'sauf pour 1000 ex : mille euros
                    Buf = Buf & " d'"
                End If
            Else
                'Gestion des exeptions pour 1000 invariable jamais de "s"
                ' si 1000 pas de 1 devant "un mille"
                If (N \ MChiffre(1)) = 1 Then
                    Buf = Buf & Mlettre(i)
                Else
                    Buf = Buf & ConverDigit(N \ MChiffre(1)) & " " & Mlettre(i)
                End If
                N = N - Int(N / MChiffre(i)) * MChiffre(i)
            End If
        End If
    Next i

    If (N > 0@) Then
        Buf = Buf & ConverDigit(N) & " "
    End If
    Buf = Buf & Unité

    If (Frac = 0@) Then
        Buf = Buf & ""    '" et zéro cent"
    Else
        Buf = Buf & " et "
        Frac = Frac * 100
        Buf = Buf & ConverDigit(Frac) & " cent"
        If Frac > 1 Then Buf = Buf & "s"
    End If

    NombreVersTexte = UCase(Left(Buf, 1)) & Mid(Buf, 2)
End Function

Private Function ConverDigit(ByVal N As Integer) As String
    Const Un = "un"
    Const Deux = "deux"
    Const Trois = "trois"
    Const Quatre = "quatre"
    Const Cinq = "cinq"
    Const Six = "six"
    Const Sept = "sept"
    Const Huit = "huit"
    Const Neuf = "neuf"
    Dim Cent As String: Cent = "cent"
    Dim Buf As String: Buf = ""
    Dim Flag As Integer
    Dim Flag1 As Integer

    'Selection des centaines
    'Mettre un "s" à cent si le chiffre est sans dizaine ni unité
    If (N Mod 100) = 0 And (N \ 100) > 1 Then
        Cent = "cents"
    End If
    Select Case (N \ 100)
        Case 0: Buf = "": Flag = False
        Case 1: Buf = Cent: Flag = True
        Case 2: Buf = Deux & " " & Cent: Flag = True
        Case 3: Buf = Trois & " " & Cent: Flag = True
        Case 4: Buf = Quatre & " " & Cent: Flag = True
        Case 5: Buf = Cinq & " " & Cent: Flag = True
        Case 6: Buf = Six & " " & Cent: Flag = True
        Case 7: Buf = Sept & " " & Cent: Flag = True
        Case 8: Buf = Huit & " " & Cent: Flag = True
        Case 9: Buf = Neuf & " " & Cent: Flag = True
    End Select
    
    If (Flag <> False) Then N = N Mod 100
    If (N > 0) Then
        If (Flag <> False) Then Buf = Buf & " "
    Else
        ConverDigit = Buf
        Exit Function
    End If

    'Selection des dixaines sup. à 10 et inf. 100
    'traitement des exceptions pour 21,31,41,51,61,71
    'ajouter "et" soixante -et - onze
    Flag = True
    Flag1 = False

    Select Case (N \ 10)
        Case 0, 1: Flag = False
        Case 2
            Buf = Buf & "vingt"
            If ((N Mod 10) = 1) Then Buf = Buf & " et "
        Case 3
            Buf = Buf & "trente"
            If ((N Mod 10) = 1) Then Buf = Buf & " et "
        Case 4
            Buf = Buf & "quarante"
            If ((N Mod 10) = 1) Then Buf = Buf & " et "
        Case 5
            Buf = Buf & "cinquante"
            If ((N Mod 10) = 1) Then Buf = Buf & " et "
        Case 6
            Buf = Buf & "soixante"
            If ((N Mod 10) = 1) Then Buf = Buf & " et "
        Case 7
            Buf = Buf & "soixante"
            If ((N Mod 10) = 1) Then Buf = Buf & " et "
            Flag1 = True
        Case 8
            Buf = Buf & "quatre-vingt"
            If ((N Mod 10) = 0) Then Buf = Buf & "s"
            If ((N Mod 10) = 1) Then Buf = Buf & "-"
        Case 9
            Buf = Buf & "quatre-vingt"
            Flag1 = True
    End Select

    If (Flag = True) Then N = N Mod 10

    'ajouter 10 pour soixante-dix et Quatre -vingt - dix
    If (Flag1 = True) Then N = N + 10
    'rajouter le séparateur "-" si buffer ne se termine pas par "et "
    If (Flag = True) And (N > 1) And Right(Buf, 3) <> "et " Then Buf = Buf & "-"

    'Selection de un à 19
    Select Case (N)
        Case 0:
        Case 1: Buf = Buf & Un
        Case 2: Buf = Buf & Deux
        Case 3: Buf = Buf & Trois
        Case 4: Buf = Buf & Quatre
        Case 5: Buf = Buf & Cinq
        Case 6: Buf = Buf & Six
        Case 7: Buf = Buf & Sept
        Case 8: Buf = Buf & Huit
        Case 9: Buf = Buf & Neuf
        Case 10: Buf = Buf & "dix"
        Case 11: Buf = Buf & "onze"
        Case 12: Buf = Buf & "douze"
        Case 13: Buf = Buf & "treize"
        Case 14: Buf = Buf & "quatorze"
        Case 15: Buf = Buf & "quinze"
        Case 16: Buf = Buf & "seize"
        Case 17: Buf = Buf & "dix-sept"
        Case 18: Buf = Buf & "dix-huit"
        Case 19: Buf = Buf & "dix-neuf"
    End Select

    ConverDigit = Buf
End Function