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