VB6/VBA Transformer nombre en texte

Introduction

La fonction peut transformer des nombres de l'unité jusqu'à 999 tera.
Prend en compte la syntaxe pour le français de France, de Belgique et de Suisse.

Préliminaires VB6

• 1 forme
• 1 label : name = label1
• OptionButton1 : name = OptionButton1 : Index = 0 : caption = "France"
• OptionButton1 : name = OptionButton1 : Index = 1 : caption = "Belgique"
• OptionButton1 : name = OptionButton1 : Index = 2 : caption = "Suisse"
• 1 texteBox : name = TextBox1 : Text = ""
• 1 CommandButton : Name = Command1 : Caption = "Envoyer"
• 1 module : name = Module1

Dans le module de la forme

Private Sub Command1_Click()
    Label1.Caption = LesMilliers(Text1.Text)
End Sub

Private Sub Form_Load()
    IniteVar
    Label1.Caption = LesMilliers("162")
End Sub

Private Sub Option1_Click(Index As Integer)
    pays = Index
    IniteVar
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        Label1.Caption = LesMilliers(Text1.Text)
    End If
End Sub

Dans Module1

Public pays As Integer
Private Unite(19) As String 
Private Dixaines(2 To 9) As String 

Public Sub IniteVar()
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 "

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

End Sub
Function LesMilliers(Nombre As String) As String

Dim i As Integer, e As Integer, Txt As String
Dim ValNb(6) As Double
Dim strResultat(6) As String
Dim strTemp As String
Dim a As String

    If Val(Nombre) < 1 Then LesMilliers = "Zéro": Exit Function
reco:
    If Len(Nombre) / 3 <> Int(Len(Nombre) / 3) Then
        Nombre = "0" & Nombre
        GoTo reco
    End If
    e = (Len(Nombre) / 3)
    For i = 0 To e - 1
        Txt = Mid(Nombre, (i * 3) + 1, 3)
        ValNb(i) = Val(Txt)
        strResultat(i) = Centaine(Txt)
    Next i
    i = 0
    If e > 4 Then 'terra
        strTemp = strResultat(0) & "terra "
        i = i + 1
    End If
    If e > 3 Then 'milliard
        strTemp = strTemp & strResultat(i) & "milliard "
        i = i + 1
    End If
    If e > 2 Then 'million
        If ValNb(i) = 1 Then a = "million " Else a = "millions "
        strTemp = strTemp & strResultat(i) & a
        i = i + 1

    End If
    If e > 1 Then 'millier
        If ValNb(i) = 1 Then
            strTemp = strTemp & "mille "
        Else
            strTemp = strTemp & strResultat(i) & "mille "
        End If
        i = i + 1
    End If
    If e > 0 Then 'les unités
        strTemp = strTemp & strResultat(i)
    Else 'pas de donnée
        strTemp = "Zéro"
    End If
    LesMilliers = 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 strBuff = "et un " Else strBuff = Unite(e(3))
    
    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
        strBuff = Dixaines(e(2)) & strBuff
    Else
        If e(0) > 89 Then i = 80 Else i = 60
        strBuff = Dixaines(e(2) - 1) & Unite(e(0) - i)
    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)) & a & strBuff
    End If
    Centaine = strBuff
End Function