Nombre en lettres (VBA)

NBLETTR.bas

'
' Conversion des nombres en lettres
'
' Copyright (c) 1999 René & Guy DEVICHI
'
Option Explicit


Dim dizaines(9)     As String
Dim unités(19)      As String
Dim initialisé      As Boolean

Public Function NL(x As Double) As String

    NL = francs_lettres(x, "franc", "francs")
End Function

Public Function NLF(x As Double) As String

    NLF = francs_lettres(x, "franc", "francs")
End Function

Public Function NLE(x As Double) As String

    NLE = francs_lettres(x, "euro", "euro")
End Function

Public Function Ordinal(x As Long) As String
    Dim l   As String
    
    initialiser
    
    If x = 0 Then
        Ordinal = "zéro"
    ElseIf x = 1 Then
        Ordinal = "premier"
    Else
        
        Ordinal = entier_lettres(x)
        
        l = Right$(Ordinal, 1)
        If l = "e" Then
            Ordinal = Left$(Ordinal, Len(Ordinal) - 1) & "ième"
        ElseIf l = "q" Then
            Ordinal = Ordinal & "uième"
        ElseIf l = "f" Then
            Ordinal = Left$(Ordinal, Len(Ordinal) - 1) & "vième"
            
        ElseIf Right$(Ordinal, 6) = "vingts" Then
            Ordinal = Left$(Ordinal, Len(Ordinal) - 1) & "ième"
        ElseIf Right$(Ordinal, 5) = "cents" Then
            Ordinal = Left$(Ordinal, Len(Ordinal) - 1) & "ième"
        Else
            Ordinal = Ordinal & "ième"
        End If
        
    End If
End Function

Private Sub initialiser()
    If initialisé Then Exit Sub
    
    dizaines(2) = "vingt"
    dizaines(3) = "trente"
    dizaines(4) = "quarante"
    dizaines(5) = "cinquante"
    dizaines(6) = "soixante"
    dizaines(8) = "quatre-vingt"
    
    unités(0) = ""
    unités(1) = "un"
    unités(2) = "deux"
    unités(3) = "trois"
    unités(4) = "quatre"
    unités(5) = "cinq"
    unités(6) = "six"
    unités(7) = "sept"
    unités(8) = "huit"
    unités(9) = "neuf"
    unités(10) = "dix"
    unités(11) = "onze"
    unités(12) = "douze"
    unités(13) = "treize"
    unités(14) = "quatorze"
    unités(15) = "quinze"
    unités(16) = "seize"
    unités(17) = "dix-sept"
    unités(18) = "dix-huit"
    unités(19) = "dix-neuf"

    initialisé = True
End Sub

Private Function francs_lettres(ByVal x As Double, monnaie As String, monnaies As String) As String
    Dim c   As Integer      ' centimes
    Dim f   As Long         ' francs (entier)

    initialiser
    
    ' montant négatif: on l'encadre de parenthèses
    '
    If x < 0 Then
        francs_lettres = "(" & francs_lettres(-x, monnaie, monnaies) & ")"
        Exit Function
    End If
    
    f = Int(x + 0.005)      ' francs arrondis
    
    If f >= 1000000 Then
         francs_lettres = "pfff... trop cher !"
         Exit Function
    End If
    
    If x = 0 Then
        francs_lettres = "zéro"
    Else

        ' calcule les centimes arrondis
        '
        c = Int(x * 100 + 0.5) Mod 100
        If c <> 0 Then
            '
            ' on précise les centimes
            
            francs_lettres = francs_lettres(f, monnaie, monnaies) & " " & _
                    c & " centime" & IIf(c <= 1, "", "s")
                    
            Exit Function
        End If

        ' le nombre s'arrondit à un entier
        '
        francs_lettres = entier_lettres(f)
            
    End If

    
    ' rajoute le mot franc à la suite du nombre entier
    '
    If x <= 1 Then
        francs_lettres = francs_lettres & " " & monnaie
    Else
        francs_lettres = francs_lettres & " " & monnaies
    End If
    
End Function

Private Function entier_lettres(ByVal x As Long) As String
    Dim u   As Integer      ' unités
    Dim d   As Integer      ' dizaines
    Dim c   As Integer      ' centaines
    
    ' on ne traite pas les nombres négatifs
    '
    If x < 0 Then x = -x
    
    If x < 20 Then
    
        entier_lettres = unités(x)
    Else
    
        If x < 70 Then
            
            d = x \ 10
            u = x Mod 10
            
            Select Case u
            Case 0
                entier_lettres = dizaines(d)
            Case 1
                entier_lettres = dizaines(d) & " et " & unités(u)
            Case Is > 1
                entier_lettres = dizaines(d) & "-" & unités(u)
            End Select
        
        ElseIf x < 80 Then
            '
            ' nombres compris entre 70 et 79
                        
            u = x Mod 10
            
            If x = 71 Then
                entier_lettres = dizaines(6) & " et " & unités(11)
            Else
                entier_lettres = dizaines(6) & "-" & unités(u + 10)
            End If
            
        ElseIf x < 90 Then
            '
            ' nombres compris entre 80 et 89
            
            u = x Mod 10
            
            If x = 80 Then
                entier_lettres = dizaines(8) & "s"
            Else
                entier_lettres = dizaines(8) & "-" & unités(u)
            End If
        
        ElseIf x < 100 Then
            '
            ' nombres entre 90 et 91
            
            u = x Mod 10
            
            entier_lettres = dizaines(8) & "-" & unités(u + 10)
        
        ElseIf x < 1000 Then
            
            c = x \ 100    ' les centaines
            d = x Mod 100  ' unités et dizaines
            
            If c >= 2 Then
                If d = 0 Then
                    entier_lettres = unités(c) & " cents"
                Else
                    entier_lettres = unités(c) & " cent " & entier_lettres(d)
                    
                End If
            Else
                
                If d > 0 Then
                    entier_lettres = "cent " & entier_lettres(d)
                Else
                    entier_lettres = "cent"
                End If
            End If
            
        ElseIf x < 1000000 Then
        
            c = x \ 1000       ' les milliers
            d = x Mod 1000     ' entre 0 et 999
            
            If c = 1 Then
                entier_lettres = "mille"
            Else
                entier_lettres = entier_lettres(c) & " mille"
            End If
            
            If d <> 0 Then
                entier_lettres = entier_lettres & " " & entier_lettres(d)
            End If
            
        Else
            '
            ' nombre trop gros
            
            entier_lettres = "dépassement"
        End If
    End If
    
End Function