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
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
Bonjour,
Tu as un algorithme (méthode convert) :
Ensuite, tu peux adapter, si tu as besoin de plus grand nombre
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Bonjour,
voici un code qui marche 1000000%
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager