Re : Changer un chiffre en mot.
Bonjour à tous,
voici la fonction que j'utilise pour transformer un nombre en texte
le résultat se donne en euros mais égalementt avec la spécificité "Belge" ( septante-------> soixante-dix)
Function ChLettres(nombre As Double) As String
Dim TRANCHE(1 To 4)
Dim ECH As Variant
Dim UNI As Variant
Dim DN As Variant
Dim DIZ As Variant
Dim N3 As Integer
If nombre >= 1000000000000# Then
ChLettres = " !!! Nombre trop grand !!!"
Exit Function
End If
ECH = Array("", "milliard", "million", "mille")
UNI = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf")
DN = Array("", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf")
DIZ = Array("", "dix", "vingt", "trente", "quarante", "cinquante", "soixante", "septante", "quatre-vingt", "nonante")
' Partie entière
If Int(nombre) = 0 Then
FIN = True
ChLettres = " zéro"
Else
FIN = False
reste = nombre
N = Format(Int(nombre), "000000000000")
J = 1
For i = 0 To 3
TRANCHE(J) = Mid(N, (i * 3) + 1, 3)
J = J + 1
Next i
T = 1
End If
While T <= 4 And FIN = False
If TRANCHE(T) > 0 Then
c = Val(Mid(TRANCHE(T), 1, 1))
D = Val(Mid(TRANCHE(T), 2, 1))
U = Val(Mid(TRANCHE(T), 3, 1))
'
' Traitement des centaines
'
Select Case c
Case 1
ChLettres = ChLettres & " " & "cent"
Case Is > 1
ChLettres = ChLettres & " " & UNI(c) & " cent"
If (D * 10) + U = 0 And T = 4 Then
ChLettres = ChLettres & "s"
FIN = True
Else
If (D * 10) + U = 0 And (T = 1 Or T = 2) Then ChLettres = ChLettres & "s"
End If
End Select
'
' Traitement des dizaines et unités
'
If FIN = False Then
Select Case D
Case 0
Select Case U
Case 1
If T = 3 Then
If c <> 0 Then
ChLettres = ChLettres & " " & UNI(U)
End If
Else
ChLettres = ChLettres & " " & UNI(U)
End If
Case Is > 1
ChLettres = ChLettres & " " & UNI(U)
End Select
Case 1
ChLettres = ChLettres & " " & DN(U + 1)
Case 2 To 6
ChLettres = ChLettres & " " & DIZ(D)
Select Case U
Case 1
ChLettres = ChLettres & " et " & UNI(U)
Case Is > 1
ChLettres = ChLettres & "-" & UNI(U)
End Select
Case 7, 9
ChLettres = ChLettres & " " & DIZ(D)
If Pays = "F" Then
Select Case D * 10 + U
Case 71
ChLettres = ChLettres & " et " & DN(U + 1)
Case Else
ChLettres = ChLettres & "-" & DN(U + 1)
End Select
Else
Select Case U
Case 1
ChLettres = ChLettres & " et " & UNI(U)
Case Is > 1
ChLettres = ChLettres & "-" & UNI(U)
End Select
End If
Case Else
ChLettres = ChLettres & " " & DIZ(D)
Select Case U
Case 0
If T = 4 Then
ChLettres = ChLettres & "s"
FIN = True
Else
If T = 1 Or T = 2 Then ChLettres = ChLettres & "s"
End If
Case Else
ChLettres = ChLettres & "-" & UNI(U)
End Select
End Select
End If
If FIN = False Then
reste = reste - TRANCHE(T) * 1000 ^ (4 - T)
Select Case T
Case 1, 2
ChLettres = ChLettres & " " & ECH(T)
If TRANCHE(T) = 1 And Int(reste) = 0 Then
ChLettres = ChLettres & " de"
FIN = True
Else
If TRANCHE(T) > 1 Then
If Int(reste) = 0 Then
ChLettres = ChLettres & "s de"
FIN = True
Else
ChLettres = ChLettres & "s"
End If
End If
End If
Case 3
ChLettres = ChLettres & " " & ECH(T)
If reste = 0 Then FIN = True
Case 4
FIN = True
End Select
End If
End If
T = T + 1
Wend
If Right(ChLettres, 5) <> " euro" Then
ChLettres = ChLettres & " euro"
End If
If Int(nombre) > 1 Then ChLettres = ChLettres & "s"
' Partie fractionnaire
N1 = nombre * 100
N2 = Int(nombre) * 100
N3 = N1 - N2
If N3 <> 0 Then
If Devise = "SD" Then
ChLettres = ChLettres & " virgule"
Else
ChLettres = ChLettres & " & "
End If
Fract = Format(N3, "00")
D = Val(Mid(Fract, 1, 1))
U = Val(Mid(Fract, 2, 1))
'
' Traitement des centièmes et dizièmes
'
Select Case D
Case 0
ChLettres = ChLettres & " " & UNI(U)
Case 1
ChLettres = ChLettres & " " & DN(U + 1)
Case 2 To 6
ChLettres = ChLettres & " " & DIZ(D)
Select Case U
Case 1
ChLettres = ChLettres & " et " & UNI(U)
Case Is > 1
ChLettres = ChLettres & "-" & UNI(U)
End Select
Case 7, 9
ChLettres = ChLettres & " " & DIZ(D)
If Pays = "F" Then
Select Case D * 10 + U
Case 71
ChLettres = ChLettres & " et " & DN(U + 1)
Case Else
ChLettres = ChLettres & "-" & DN(U + 1)
End Select
Else
Select Case U
Case 1
ChLettres = ChLettres & " et " & UNI(U)
Case Is > 1
ChLettres = ChLettres & "-" & UNI(U)
End Select
End If
Case Else
ChLettres = ChLettres & " " & DIZ(D)
Select Case U
Case 0
ChLettres = ChLettres & "s"
Case Else
ChLettres = ChLettres & "-" & UNI(U)
End Select
End Select
ChLettres = ChLettres & " cent"
If Fract > 1 Then ChLettres = ChLettres & "s"
End If
End Function
merci à l'auteur dont j'ai oublié le mon
à+
Philippe
