Traduire en lettres un montant en chiffres ?

Version imprimable

11/02/2010, 15h58
JauB

Traduire en lettres un montant en chiffres ?

Bonjour,
Est ce qu'il y a moyen pour traduire un montant écrit en chiffre en une expression en lettres ? (une classe pré-existante ou un algorithme que vous avez vu quelque part).
Merci d'avance :mrgreen:

Bonjour,

Tu as un algorithme (méthode convert) :

Citation:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Conversion chiffres en lettres"
ClientHeight = 3060
ClientLeft = 45
ClientTop = 435
ClientWidth = 4080
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3060
ScaleWidth = 4080
StartUpPosition = 3 'Windows Default
Begin VB.TextBox Text2
Height = 615
Left = 140
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 2
Top = 2280
Width = 3735
End
Begin VB.CommandButton Command1
Caption = "Convert"
Height = 375
Left = 140
TabIndex = 1
Top = 1200
Width = 3735
End
Begin VB.TextBox Text1
Height = 315
Left = 140
TabIndex = 0
Top = 720
Width = 3735
End
Begin VB.Label Label3
Caption = "La somme en lettres :"
Height = 255
Left = 140
TabIndex = 4
Top = 1800
Width = 2895
End
Begin VB.Label Label2
Caption = "La somme en chiffres :"
Height = 255
Left = 140
TabIndex = 3
Top = 240
Width = 2175
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim NT As Double
Dim R
Public Sub convert(N As Integer)
L1 = Array("Un ", "Deux ", "Trois ", "Quatre ", "Cinq ", "Six ", "Sept ", "Huit ", "Neuf ", "Dix ", "Onze ", "Douze ", _
"Treize ", "Quatorze ", "Quinze ", "Seize ", "Dix-sept ", "Dix huit ", "Dix neuf ", "Vingt ", "Trente ", "Quarante ", "Cinquante ", _
"Soixante ", "Quatre-vingt ")
L2 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 30, 40, 50, 60, 80)
C = Int(N / 100)
If C = 1 Then R = R + "Cent "
R1 = N - (C * 100)
If C > 1 Then
If R1 > 0 Then
R = R + L1(C - 1) & "Cent "
Else
R = R + L1(C - 1) & "Cents "
End If
End If
D = Int(R1 / 10) * 10
U = N - (C * 100) - D
If D = 10 Then D = 0: U = U + 10
If D = 70 Or D = 90 Then D = D - 10: U = U + 10
For I = 0 To 24
If D = L2(I) Then R = R + L1(I)
Next
If U > 0 Then R = R + L1(U - 1)
End Sub
Private Sub Command1_Click()
R = ""
NT = Val(Text1.Text)
If NT > 999999999.99 Or NT < 1 Then
MsgBox "Le nombre doit être compris entre 1 et 999999999.99", vbOKOnly, "Erreur"
Text1.SetFocus: Exit Sub
End If
N = Int(NT / 1000000)
If N > 1 Then convert (N): R = R + "Millions "
If N = 1 Then R = "Un Million "
D1 = NT - (N * 1000000)
N = Int(D1 / 1000)
If N > 1 Then convert (N): R = R + "Mille "
If N = 1 Then R = "Mille "
D2 = D1 - (N * 1000)
N = Int(D2)
If N >= 1 Then convert (N): R = R + "DHS "
PDE = Int((NT - Int(NT)) * 100)
N = PDE
If N >= 1 Then convert (N): R = R + "CTS "
Text2.Text = UCase(Left(R, 1)) + LCase(Mid(R, 2))
End Sub
Private Sub Text1_KeyPress(KA As Integer)
If (Chr(KA) < "0" Or Chr(KA) > "9") And KA <> vbKeyBack And Chr(KA) <> "." Then KA = 0
End Sub
Private Sub Text2_KeyPress(KA As Integer)
KA = 0
End Sub

Ensuite, tu peux adapter, si tu as besoin de plus grand nombre

12/02/2010, 11h01
JauB

ça me va.
Merci beaucoup :ccool:

Bonjour,
voici un code qui marche 1000000%

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
Public Function Francise(ByVal nb As String) As String
 
Do While Left(nb, 1) = "0"
If Left(nb, 1) = "0" Then nb = Mid(nb, 2) 'suppression des zéros à gauche
Loop
Select Case Len(nb)
Case 0
Francise = ""
Case 1
Select Case nb
Case "0" : Francise = "zéro"
Case "1" : Francise = "un"
Case "2" : Francise = "deux"
Case "3" : Francise = "trois"
Case "4" : Francise = "quatre"
Case "5" : Francise = "cinq"
Case "6" : Francise = "six"
Case "7" : Francise = "sept"
Case "8" : Francise = "huit"
Case "9" : Francise = "neuf"
End Select
Case 2
Select Case nb
Case "10" : Francise = "dix"
Case "11" : Francise = "onze"
Case "12" : Francise = "douze"
Case "13" : Francise = "treize"
Case "14" : Francise = "quatorze"
Case "15" : Francise = "quinze"
Case "16" : Francise = "seize"
Case "17" To "19" : Francise = "dix " & Francise(Right(nb, 1))
Case "20" To "29" : Francise = "vingt " & Francise(Right(nb, 1))
Case "30" To "39" : Francise = "trente " & Francise(Right(nb, 1))
Case "40" To "49" : Francise = "quarante " & Francise(Right(nb, 1))
Case "50" To "59" : Francise = "cinquante " & Francise(Right(nb, 1))
Case "60" To "69" : Francise = "soixante " & Francise(Right(nb, 1))
Case "70" To "79"
nb = Format(Val(nb) - 60, "##")
Francise = "soixante " & Francise(nb)
If Right(Francise, 4) = "onze" Then Francise = "soixante et onze"
Case "80" : Francise = "quatre-vingts"
Case "81" To "99"
nb = Format(Val(nb) - 80, "##")
Francise = "quatre-vingt " & Francise(nb)
End Select
If Right(Francise, 2) = "un" And nb > "20" And nb < 70 Then Francise = Left(Francise, Len(Francise) - 2) & "et un"
 
If Right(Francise, 4) = "zéro" Then Francise = Left(Francise, Len(Francise) - 5)
Case 3
Select Case Left(nb, 1)
Case "1" : Francise = "cent " & Francise(Mid(nb, 2))
Case Else
Francise = Francise(Left(nb, 1)) & " cent " & Francise(Mid(nb, 2))
If Right(Francise, 6) = " cent " Then Francise = Left(Francise, Len(Francise) - 1) & "s"
End Select
Case 4 To 6
Francise = Francise(Left(nb, Len(nb) - 3)) & " mille " & Francise(Right(nb, 3))
If Left(Francise, 2) = "un" Then Francise = Mid(Francise, 4)
Case 7 To 9
Francise = Francise(Left(nb, Len(nb) - 6)) & " millions " & Francise(Right(nb, 6))
If Left(Francise, 2) = "un" Then Francise = Left(Francise, 10) & Mid(Francise, 12)
Case 10 To 12
Francise = Francise(Left(nb, Len(nb) - 9)) & " milliards " & Francise(Right(nb, 9))
If Left(Francise, 2) = "un" Then Francise = Left(Francise, 11) & Mid(Francise, 13)
Case Else
End Select
End Function
'-------------------------------------------------------------------
Public Function Nombre_en_lettres(ByVal nb As String) As String
Dim Affichage As String, Entier As String, Décimal As String
nb = Replace(nb, ".", ",") '<- à supprimer selon paramètres régionaux
'If Not IsNumeric(nb) Then
' MsgBox(nb & " n'est pas un nombre")
'' Exit Function
'End If
If InStr(nb, ",") = 0 Then 'c'est un entier
Affichage = Francise(nb)
Else 'c'est un décimal
Do While Right(nb, 1) = "0" 'suppression des zéros à droite de la partie décimale
If Right(nb, 1) = "0" Then nb = Left(nb, Len(nb) - 1)
Loop
Entier = Francise(Left(nb, InStr(nb, ",") - 1))
If Entier = "un" Then
Entier = Entier & " Dhs "
Else
If Entier <> "" Then
Entier = Entier & " Dhs "
End If
End If
If Len(Mid(nb, InStr(nb, ",") + 1)) = 1 Then nb = nb & "0" '2 décimales
Décimal = Francise(Mid(nb, InStr(nb, ",") + 1))
Affichage = Entier & Décimal
If Décimal <> "" Then
Affichage = Affichage & " " & "centime"
If Décimal <> "un" Then Affichage = Affichage & "s"
End If
End If
Nombre_en_lettres = Affichage ' retour fonction
End Function