Discussion :

[Nacimed71]

Bonjour;

Dans "A1" j'ai un montant "format Monétaire", dans "B1" le montant est en toutes lettres.

Exemple
Dans "A1" => 1 500,300 Dt
Dans "B1" => Mille Cinq Cent Dinars, 300 Millimes.

Y a t-il une formule pour convertir ces montants sans les traiter manuellement.

cdt

[Piga25]

Bonjour Nacimed 71

Code à mettre dans un module

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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
Function lireCentaine(ByVal Montant As Double) As String
Dim ChiffreLettre
Dim Centaine As Double
Dim Dizaine As Double
Dim T As String
Dim Chaine As String
ChiffreLettre = Array("un", "deux", "trois", "quatre", "cinq", "six", _
                "sept", "huit", "neuf", "dix", _
                "onze", "douze", "treize", "quatorze", "quinze", _
                "seize", "dix-sept", "dix-huit", "dix-neuf")
Centaine = Int(Montant / 100)
Select Case Centaine
    Case 0
        Chaine = ""
    Case 1
        Chaine = "cent"
    Case Else
        Chaine = ChiffreLettre(Centaine - 1) & " cent"
End Select
Dizaine = Modulo(Montant, 100)
Select Case Dizaine
    Case 0
        T = ""
    Case 1 To 19
        T = ChiffreLettre(Dizaine - 1)
    Case 20
        T = "vingt"
    Case 21
        T = "vingt et un"
    Case 22 To 29
        T = "vingt " & ChiffreLettre(Dizaine - 21)
    Case 30
        T = "trente"
    Case 31
        T = "trente et un"
    Case 32 To 39
        T = "trente-" & ChiffreLettre(Dizaine - 31)
    Case 40
        T = "quarante"
    Case 41
        T = "quarante et un"
    Case 42 To 49
        T = "quarante-" & ChiffreLettre(Dizaine - 41)
    Case 50
        T = "cinquante"
    Case 51
        T = "cinquante et un"
    Case 52 To 59
        T = "cinquante-" & ChiffreLettre(Dizaine - 51)
    Case 60
        T = "soixante"
    Case 61
        T = "soixante et un"
    Case 62 To 69
        T = "soixante-" & ChiffreLettre(Dizaine - 61)
    Case 70
        T = "soixante-dix"
    Case 71
        T = "soixante et onze"
    Case 72 To 79
        T = "soixante-" & ChiffreLettre(Dizaine - 61)
    Case 80
        T = "quatre-vingts"
    Case 81 To 89
        T = "quatre-vingt " & ChiffreLettre(Dizaine - 81)
    Case 90 To 99
        T = "quatre-vingt " & ChiffreLettre(Dizaine - 81)
    Case Else
        T = "Erreur de conversion !"
End Select
If (Chaine & " " & T) = " " Then
    lireCentaine = ""
Else
    lireCentaine = LTrim(Chaine & " ") & T
End If
End Function
Function Modulo(ByVal Nombre As Double, ByVal Diviseur As Double) As Double
    Modulo = Nombre - (Diviseur * Int(Nombre / Diviseur))
End Function
Function Arrondir(ByVal ValeurArrondi As Double, ByVal NbreDeci As Integer) As Double
    Arrondir = ValeurArrondi + (5 * 100 ^ -(NbreDeci + 1))
    Arrondir = Int(Arrondir * 100 ^ NbreDeci) / 100 ^ NbreDeci
 
End Function
Function NbreLettres(ByVal Total As Double) As String
 
    Dim Millions As Double
    Dim Milliers As Double
    Dim cent As Double
    Dim decimales As Double
    Dim T0 As String
    Dim T1 As String
    Dim T2 As String
    Dim T3 As String
    Dim Resultat As String
    Dim T As String
    Dim S1, S2 As String
    Total = Arrondir(Total, 2)
    Millions = Int(Modulo(Int(Total / 1000000), 1000))
    Milliers = Int(Modulo(Int(Total / 1000), 1000))
    cent = Int(Modulo(Total, 1000))
    decimales = Arrondir((Modulo(Total * 1000, 1000)), 0)
    S1 = ""
    S2 = ""
    If cent <= 1 Then
        If Milliers < 1 Then
        Else
            S1 = "s"
        End If
    Else
        S1 = "s"
    End If
 
    If decimales <= 1 Then S2 = "" Else S2 = "s"
    T0 = lireCentaine(Millions)
    T1 = lireCentaine(Milliers)
    T2 = lireCentaine(cent)
    T3 = lireCentaine(decimales)
    If (T0 = "" And T1 = "" And T3 = "" And Right(T2, 5) = "cent ") Then
        If cent > 100 Then T2 = RTrim(T2) & "s"
    End If
    If T0 <> "" Then
        Resultat = T0 & " millions "
        If T1 = "" And T2 = "" And T3 = "" Then
            Resultat = T0 & " millions de dinars"
        End If
    Else
        Resultat = ""
    End If
    If T1 <> "" Then
        If T1 = "un" Then
            T1 = ""
        End If
        Resultat = Resultat & T1 & " mille "
    Else
        Resultat = Resultat & ""
    End If
    If T2 <> "" Then
        Resultat = Resultat & T2 & " dinars"
    Else
        If Resultat <> "" Then
            Resultat = Resultat
        End If
    End If
    If T3 <> "" Then
        If Resultat <> "" Then
            Resultat = Resultat & " et " & T3 & " millimes"
        Else
            Resultat = T3
        End If
    End If
    NbreLettres = Resultat
End Function

La fonction sera : =NbreLettres()

Voir fichier si cela convient

[hben1961]

Bonjour à tous,

Avec le code çi-dessous, modifié à la demande, à mettre dans un module (fonction personnalisée nommée "Nbre_Lettres"), on a une réponse à la question...

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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
Function lireCentaine(ByVal Montant As Double) As String
Dim ChiffreLettre
Dim Centaine As Double
Dim Dizaine As Double
Dim T As String
Dim Chaine As String
ChiffreLettre = Array("un", "deux", "trois", "quatre", "cinq", "six", _
                "sept", "huit", "neuf", "dix", _
                "onze", "douze", "treize", "quatorze", "quinze", _
                "seize", "dix-sept", "dix-huit", "dix-neuf")
Centaine = Int(Montant / 100)
 
Select Case Centaine
    Case 0
        Chaine = ""
    Case 1
        Chaine = "cent"
    Case Else
        Chaine = ChiffreLettre(Centaine - 1) & " cent"
End Select
Dizaine = Modulo(Montant, 100)
Select Case Dizaine
    Case 0
        T = ""
    Case 1 To 19
        T = ChiffreLettre(Dizaine - 1)
    Case 20
        T = "vingt"
    Case 21
        T = "vingt et un"
    Case 22 To 29
        T = "vingt " & ChiffreLettre(Dizaine - 21)
    Case 30
        T = "trente"
    Case 31
        T = "trente et un"
    Case 32 To 39
        T = "trente " & ChiffreLettre(Dizaine - 31)
    Case 40
        T = "quarante"
    Case 41
        T = "quarante et un"
    Case 42 To 49
        T = "quarante " & ChiffreLettre(Dizaine - 41)
    Case 50
        T = "cinquante"
    Case 51
        T = "cinquante et un"
    Case 52 To 59
        T = "cinquante " & ChiffreLettre(Dizaine - 51)
    Case 60
        T = "soixante"
    Case 61
        T = "soixante et un"
    Case 62 To 69
        T = "soixante " & ChiffreLettre(Dizaine - 61)
    Case 70
        T = "soixante-dix"
    Case 71
        T = "soixante et onze"
    Case 72 To 79
        T = "soixante " & ChiffreLettre(Dizaine - 61)
    Case 80
        T = "quatre vingts"
    Case 81 To 89
        T = "quatre vingt " & ChiffreLettre(Dizaine - 81)
    Case 90 To 99
        T = "quatre vingt " & ChiffreLettre(Dizaine - 81)
    Case Else
        T = "Erreur de conversion !"
End Select
If (Chaine & " " & T) = " " Then
    lireCentaine = ""
Else
    lireCentaine = LTrim(Chaine & " ") & T
End If
End Function
Function Modulo(ByVal Nombre As Double, ByVal Diviseur As Double) As Double
    Modulo = Nombre - (Diviseur * Int(Nombre / Diviseur))
End Function
Function Arrondir(ByVal ValeurArrondi As Double, ByVal NbreDeci As Integer) As Double
    Arrondir = ValeurArrondi + (5 * 10 ^ -(NbreDeci + 1))
    Arrondir = Int(Arrondir * 10 ^ NbreDeci) / 10 ^ NbreDeci
 End Function
Function Nbre_Lettres(ByVal Total As Double) As String
    Dim Millions As Double
    Dim Milliers As Double
    Dim cent As Double
    Dim decimales As Double
    Dim T0 As String
    Dim T1 As String
    Dim T2 As String
    Dim T3 As String
    Dim Resultat As String
    Dim T As String
    Dim S1, S2 As String
    Total = Arrondir(Total, 3)
    Millions = Int(Modulo(Int(Total / 1000000), 1000))
    Milliers = Int(Modulo(Int(Total / 1000), 1000))
    cent = Int(Modulo(Total, 1000))
    decimales = Arrondir((Modulo(Total * 1000, 1000)), 0)
    S1 = ""
    S2 = ""
    If Milliers <= 1 Then S1 = "" Else S1 = "s"
    If cent <= 1 Then
        If Milliers < 1 Then
            If Millions < 1 Then
                S1 = ""
            Else
                S1 = "s"
            End If
        Else
            S1 = "s"
        End If
    Else
        S1 = "s"
    End If
    If decimales <= 1 Then S2 = "" Else S2 = "s"
    If Total <= 1 Then S1 = "" Else S1 = "s"
    T0 = lireCentaine(Millions)
    T1 = lireCentaine(Milliers)
    T2 = lireCentaine(cent)
    T3 = lireCentaine(decimales)
    If (T0 = "" And T1 = "" And T3 = "" And Right(T2, 5) = "cent ") Then
        If cent > 100 Then T2 = RTrim(T2) & "s"
    End If
    If T0 <> "" Then
   If (T1 <> "") Then
   If (T2 <> "") Then
   T0 = T0
   T1 = "" & T1
   T2 = "" & T2
   End If
   End If
   End If
   If T0 = "" Then
   If (T1 <> "") Then
   If (T2 <> "") Then
   T0 = T0
   T1 = T1
   T2 = "" & T2
   End If
   End If
   End If
   If T0 <> "" Then
   If (T1 <> "") Then
   If (T2 = "") Then
   T0 = T0
   T1 = "" & T1
   T2 = T2
   End If
   End If
   End If
   If T0 = "" Then
   If (T1 <> "") Then
   If (T2 = "") Then
   T0 = T0
   T1 = T1
   T2 = T2
   End If
   End If
   End If
   If T0 <> "" Then
   If (T2 <> "") Then
   If (T1 = "") Then
   T0 = T0
   T2 = "" & T2
   T1 = T1
   End If
   End If
   End If
 
   If T0 = "" Then
   If (T2 <> "") Then
   If (T1 = "") Then
   T0 = T0
   T1 = T1
   T2 = T2
   End If
   End If
   End If
 
    If T0 <> "" Then
        Resultat = T0 & " million "
        If T1 = "" And T2 = "" And T3 = "" Then
            Resultat = T0 & " million de"
        End If
    Else
        Resultat = ""
    End If
    If T1 <> "" Then
        If T1 = "un" Then
            T1 = ""
        End If
        Resultat = Resultat & T1 & " mille "
    Else
        Resultat = Resultat & " Dinars "
    End If
    If T2 <> "" Then
        Resultat = Resultat & T2 & " Dinars, " & T3 & " Millimes"
    Else
        If Resultat <> "" Then
            Resultat = Resultat
        End If
    End If
    Nbre_Lettres = Resultat
End Function

Et cette fonction est utilisable comme suit (en B1 selon ton cas):
* En caractères minuscules:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=nbre_lettres(A1)

* En caractères majuscules:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=MAJUSCULE(nbre_lettres(A1))

* Les premières lettres en majuscules (comme dans ton exemple):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=NOMPROPRE(nbre_lettres(A1))

NB: Les chiffres des millimes (trois chiffres) sont aussi transformés en lettres...

Cordialement

[mercatog]

J'ai testé le code de hben, quelque fois bizarre

Dinars un Dinars, Millimes à la place de un Dinar
mille au lieu de mille Dinars
Nombres négatifs au cas où (!!)

Ci-joint modifications avec suppressions de lignes inutiles

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
Function Nbre_Lettres(ByVal Total As Double) As String
Dim Millions As Double, Milliers As Double, Cent As Double, Decimales As Double
Dim T0 As String, T1 As String, T2 As String, T3 As String, Resultat As String
Dim S1 As String, S2 As String, T As String, Sign As String
Dim Dbl As Boolean
 
If Total < 0 Then
    Total = -1 * Total
    Sign = "Moins "
End If
Total = Arrondir(Total, 3)
Millions = Int(Modulo(Int(Total / 1000000), 1000))
Milliers = Int(Modulo(Int(Total / 1000), 1000))
Cent = Int(Modulo(Total, 1000))
Decimales = Arrondir((Modulo(Total * 1000, 1000)), 0)
 
If Decimales > 1 Then S2 = "s"
If Int(Total) > 1 Then S1 = "s"
 
T0 = lireCentaine(Millions)
T1 = lireCentaine(Milliers)
T2 = lireCentaine(Cent)
T3 = lireCentaine(Decimales)
 
If T0 = "" Then
    If T1 = "" And T3 = "" And Right(T2, 5) = "cent " Then
        If Cent > 100 Then T2 = RTrim(T2) & "s"
    End If
Else
    Resultat = T0 & " million "
    If T1 = "" And T2 = "" And T3 = "" Then
        Resultat = T0 & " million de"
    End If
End If
If T1 <> "" Then
    If T1 = "un" Then T1 = ""
    Resultat = Resultat & T1 & " mille "
End If
If Resultat & T2 <> "" Then Dbl = True
Resultat = IIf(Dbl, Resultat & T2 & " Dinar" & S1, "") & IIf(T3 <> "", IIf(Dbl, ", ", "") & T3 & " Millime" & S2, "")
 
Nbre_Lettres = Sign & Resultat
End Function

[kiki29]

Salut,une couche de plus sortie des décombres

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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
Option Explicit
 
'----------------------------------------------------------------------------------------
'
'   Devise      =0   aucune
'               =1   Euro €
'               =2   Dollar $
'               =3   €uro €
'               =4   Dinar Tunisien Dt
'
'   Langue      =0   Français
'               =1   Belgique
'               =2   Suisse
'
'   Casse       =0   Minuscule
'               =1   Majuscule en début de phrase
'               =2   Majuscule
'               =3   Majuscule en début de chaque mot
'
'   ZeroCent    =0   Ne mentionne pas les cents s'ils sont égal à 0
'               =1   Mentionne toujours les cents
'
'----------------------------------------------------------------------------------------
'
'   Conversion limitée à 999 999 999 999 999 ou 9 999 999 999 999,99
'
'----------------------------------------------------------------------------------------
 
Dim Dev As Long
 
Function ConvNumberLetter(Nombre As Double, Optional Devise As Long = 0, _
                          Optional Langue As Long = 0, _
                          Optional Casse As Long = 0, _
                          Optional ZeroCent As Long = 0) As String
Dim dblEnt As Double, lDec As Long
Dim bNegatif As Boolean
Dim strDev As String, strCentimes As String
 
    Dev = Devise
    If Nombre < 0 Then
        bNegatif = True
        Nombre = Abs(Nombre)
    End If
 
    dblEnt = Int(Nombre)
    '   100 Cents       = 1 €
    '   1000 Millimes   = 1 DT
    Select Case Devise
        Case 0 To 3
            lDec = Application.WorksheetFunction.RoundUp((Nombre - dblEnt) * 100, 2)
        Case 4
            lDec = Application.WorksheetFunction.RoundUp((Nombre - dblEnt) * 1000, 3)
    End Select
 
    If lDec = 0 Then
        If dblEnt > 999999999999999# Then
            ConvNumberLetter = "#TropGrand"
            Exit Function
        End If
    Else
        If dblEnt > 9999999999999.99 Then
            ConvNumberLetter = "#TropGrand"
            Exit Function
        End If
    End If
 
    Select Case Devise
        Case 0
            If lDec > 0 Then strDev = " virgule "
        Case 1
            strDev = " Euro"
            If dblEnt >= 1000000 And Right$(dblEnt, 6) = "000000" Then strDev = " d'Euro"
            If lDec > 0 Then strCentimes = strCentimes & " Cent"
            If lDec > 1 Then strCentimes = strCentimes & "s"
        Case 2
            strDev = " Dollar"
            If lDec > 0 Then strCentimes = strCentimes & " Cent"
        Case 3
            strDev = " €uro"
            If dblEnt >= 1000000 And Right$(dblEnt, 6) = "000000" Then strDev = " d'€uro"
            If lDec > 0 Then strCentimes = strCentimes & " Cent"
            If lDec > 1 Then strCentimes = strCentimes & "s"
        Case 4
            strDev = " Dinar"
            If dblEnt >= 1000000 And Right$(dblEnt, 6) = "000000" Then strDev = " de Dinars Tunisiens"
            If lDec > 0 Then strCentimes = strCentimes & " Millime"
            If lDec > 1 Then strCentimes = strCentimes & "s"
    End Select
 
    If dblEnt > 1 And Devise <> 0 Then strDev = strDev & "s"
    strDev = strDev & " "
    If dblEnt = 0 Then
        ConvNumberLetter = "zéro " & strDev
    Else
        ConvNumberLetter = ConvNumEnt(CDbl(dblEnt), Langue) & strDev
    End If
 
    If lDec = 0 Then
        If Devise <> 0 Then
            If ZeroCent = 1 Then
                Select Case Devise
                    Case 0 To 3
                        ConvNumberLetter = ConvNumberLetter & "zéro Cent"
                    Case 4
                        ConvNumberLetter = ConvNumberLetter & "zéro Millime"
                End Select
            End If
        End If
    Else
        If Devise = 0 Then
            ConvNumberLetter = ConvNumberLetter & ConvNumCent(lDec, Langue) & strCentimes
        Else
            ConvNumberLetter = ConvNumberLetter & ConvNumCent(lDec, Langue) & strCentimes
        End If
    End If
 
    ConvNumberLetter = Replace(ConvNumberLetter, "  ", " ")
    If bNegatif Then ConvNumberLetter = "- " & ConvNumberLetter
 
    If Left$(ConvNumberLetter, 1) = " " Then ConvNumberLetter = Right$(ConvNumberLetter, Len(ConvNumberLetter) - 1)
    If Right$(ConvNumberLetter, 1) = " " Then ConvNumberLetter = Left$(ConvNumberLetter, Len(ConvNumberLetter) - 1)
    Select Case Casse
        Case 0
            ConvNumberLetter = LCase$(ConvNumberLetter)
        Case 1
            ConvNumberLetter = UCase$(Left$(ConvNumberLetter, 1)) & LCase$(Right$(ConvNumberLetter, Len(ConvNumberLetter) - 1))
        Case 2
            ConvNumberLetter = UCase$(ConvNumberLetter)
        Case 3
            ConvNumberLetter = Application.WorksheetFunction.Proper(ConvNumberLetter)
            If Devise = 3 Then ConvNumberLetter = Replace(ConvNumberLetter, "€Uros", "€uros", , , vbTextCompare)
    End Select
 
End Function
 
Private Function ConvNumCent(Nombre As Long, Langue As Long) As String
Dim TabUnit As Variant
Dim lCent As Long, lReste As Long
Dim strReste As String
 
    TabUnit = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf", "dix")
    lCent = Int(Nombre / 100)
    lReste = Nombre - (lCent * 100)
    strReste = ConvNumDizaine(lReste, Langue, False)
 
    Select Case lCent
        Case 0
            ConvNumCent = strReste
        Case 1
            If lReste = 0 Then
                ConvNumCent = "cent"
            Else
                ConvNumCent = "cent " & strReste
            End If
        Case Else
            If lReste = 0 Then
                ConvNumCent = TabUnit(lCent) & " cents"
            Else
                ConvNumCent = TabUnit(lCent) & " cent " & strReste
            End If
    End Select
End Function
 
Private Function ConvNumDizaine(Nombre As Long, Langue As Long, bDec As Boolean) As String
Dim TabUnit As Variant, TabDiz As Variant
Dim lUnit As Long, lDiz As Long
Dim strLiaison As String
 
    Select Case Dev
        Case 0 To 3
            If bDec Then
                TabDiz = Array("zéro", "", "vingt", "trente", "quarante", "cinquante", _
                               "soixante", "soixante", "quatre-vingt", "quatre-vingt")
            Else
                TabDiz = Array("", "", "vingt", "trente", "quarante", "cinquante", _
                               "soixante", "soixante", "quatre-vingt", "quatre-vingt")
            End If
        Case 4
            If bDec Then
                TabDiz = Array("zéro", "", "vingt", "trente", "quarante", "cinquante", _
                               "soixante", "soixante-dix", "quatre-vingt", "quatre-vingt-dix")
            Else
                TabDiz = Array("", "", "vingt", "trente", "quarante", "cinquante", _
                               "soixante", "soixante-dix", "quatre-vingt", "quatre-vingt-dix")
            End If
    End Select
 
    If Nombre = 0 Then
        TabUnit = Array("zéro")
    Else
        TabUnit = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
                        "huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", _
                        "seize", "dix-sept", "dix-huit", "dix-neuf")
    End If
 
    If Langue = 1 Then
        TabDiz(7) = "septante"
        TabDiz(9) = "nonante"
    ElseIf Langue = 2 Then
        TabDiz(7) = "septante"
        TabDiz(8) = "huitante"
        TabDiz(9) = "nonante"
    End If
 
    lDiz = Int(Nombre / 10)
    lUnit = Nombre - (lDiz * 10)
    strLiaison = "-"
    If lUnit = 1 Then strLiaison = " et "
 
    Select Case lDiz
        Case 0
            strLiaison = " "
        Case 1
            lUnit = lUnit + 10
            strLiaison = ""
        Case 7
            If Langue = 0 Then lUnit = lUnit + 10
        Case 8
            If Langue <> 2 Then strLiaison = "-"
        Case 9
            If Langue = 0 Then
                lUnit = lUnit + 10
                strLiaison = "-"
            End If
    End Select
 
    ConvNumDizaine = TabDiz(lDiz)
    If lDiz = 8 And Langue <> 2 And lUnit = 0 Then ConvNumDizaine = ConvNumDizaine & "s"
    If TabUnit(lUnit) <> "" Then
        ConvNumDizaine = ConvNumDizaine & strLiaison & TabUnit(lUnit)
    Else
        ConvNumDizaine = ConvNumDizaine
    End If
End Function
 
Private Function ConvNumEnt(Nombre As Double, Langue As Long)
Dim Tmp As Double, dblReste As Double
Dim strTmp As String
Dim iCent As Long, iMille As Long, iMillion As Long
Dim iMilliard As Long, iBillion As Long
 
    Tmp = Nombre - (Int(Nombre / 1000) * 1000)
    iCent = CInt(Tmp)
    ConvNumEnt = Nz(ConvNumCent(iCent, Langue))
    dblReste = Int(Nombre / 1000)
    If Tmp = 0 And dblReste = 0 Then Exit Function
    Tmp = dblReste - (Int(dblReste / 1000) * 1000)
    If Tmp = 0 And dblReste = 0 Then Exit Function
    iMille = CInt(Tmp)
    strTmp = ConvNumCent(iMille, Langue)
 
    Select Case Tmp
        Case 0
        Case 1
            strTmp = " mille "
        Case Else
            strTmp = strTmp & " mille "
    End Select
 
    If iMille = 0 And iCent > 0 Then ConvNumEnt = "et " & ConvNumEnt
    ConvNumEnt = Nz(strTmp) & ConvNumEnt
    dblReste = Int(dblReste / 1000)
    Tmp = dblReste - (Int(dblReste / 1000) * 1000)
    If Tmp = 0 And dblReste = 0 Then Exit Function
    iMillion = CInt(Tmp)
    strTmp = ConvNumCent(iMillion, Langue)
 
    Select Case Tmp
        Case 0
        Case 1
            strTmp = strTmp & " million "
        Case Else
            strTmp = strTmp & " millions "
    End Select
 
    If iMille = 1 Then ConvNumEnt = "et " & ConvNumEnt
    ConvNumEnt = Nz(strTmp) & ConvNumEnt
    dblReste = Int(dblReste / 1000)
    Tmp = dblReste - (Int(dblReste / 1000) * 1000)
    If Tmp = 0 And dblReste = 0 Then Exit Function
    iMilliard = CInt(Tmp)
    strTmp = ConvNumCent(iMilliard, Langue)
 
    Select Case Tmp
        Case 0
        Case 1
            strTmp = strTmp & " milliard "
        Case Else
            strTmp = strTmp & " milliards "
    End Select
 
    If iMillion = 1 Then ConvNumEnt = "et " & ConvNumEnt
    ConvNumEnt = Nz(strTmp) & ConvNumEnt
    dblReste = Int(dblReste / 1000)
    Tmp = dblReste - (Int(dblReste / 1000) * 1000)
    If Tmp = 0 And dblReste = 0 Then Exit Function
    iBillion = CInt(Tmp)
    strTmp = ConvNumCent(iBillion, Langue)
 
    Select Case Tmp
        Case 0
        Case 1
            strTmp = strTmp & " billion "
        Case Else
            strTmp = strTmp & " billions "
    End Select
 
    If iMilliard = 1 Then ConvNumEnt = "et " & ConvNumEnt
    ConvNumEnt = Nz(strTmp) & ConvNumEnt
End Function
 
Private Function Nz(strNb As String) As String
    If strNb <> " zéro" Then Nz = strNb
End Function

=ConvNumberLetter(A13;4;3;3;0) 99,000 donne Quatre-Vingt-Dix-Neuf Dinars

=ConvNumberLetter(A13;4;3;3;1) 99,000 donne Quatre-Vingt-Dix-Neuf Dinars Zéro Millime

ou au choix pour 1500,300

Mille cinq cents Dinars trois cents millimes
MILLE CINQ CENTS DINARS TROIS CENTS MILLIMES
Mille Cinq Cents Dinars Trois Cents Millimes
mille cinq cents Dinars trois cents Millimes

Le même chiffre pour l'euro donne

Mille cinq cents euros trente cents

[grisan29]

bonjour a tous
une autre solution venue d'excelabo a mettre dans un module

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
Function chiffrelettre(s)
Dim A As Variant, gros As Variant
A = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
"huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix sept", _
"dix huit", "dix neuf", "vingt", "vingt et un", "vingt deux", "vingt trois", "vingt quatre", _
"vingt cinq", "vingt six", "vingt sept", "vingt huit", "vingt neuf", "trente", "trente et un", _
"trente deux", "trente trois", "trente quatre", "trente cinq", "trente six", "trente sept", _
"trente huit", "trente neuf", "quarante", "quarante et un", "quarante deux", "quarante trois", _
"quarante quatre", "quarante cinq", "quarante six", "quarante sept", "quarante huit", _
"quarante neuf", "cinquante", "cinquante et un", "cinquante deux", "cinquante trois", _
"cinquante quatre", "cinquante cinq", "cinquante six", "cinquante sept", "cinquante huit", _
"cinquante neuf", "soixante", "soixante et un", "soixante deux", "soixante trois", _
"soixante quatre", "soixante cinq", "soixante six", "soixante sept", "soixante huit", _
"soixante neuf", "soixante dix", "soixante et onze", "soixante douze", "soixante treize", _
"soixante quatorze", "soixante quinze", "soixante seize", "soixante dix sept", _
"soixante dix huit", "soixante dix neuf", "quatre-vingts", "quatre-vingt un", _
"quatre-vingt deux", "quatre-vingt trois", "quatre-vingt quatre", "quatre-vingt cinq", _
"quatre-vingt six", "quatre-vingt sept", "quatre-vingt huit", "quatre-vingt neuf", _
"quatre-vingt dix", "quatre-vingt onze", "quatre-vingt douze", "quatre-vingt treize", _
"quatre-vingt quatorze", "quatre-vingt quinze", "quatre-vingt seize", "quatre-vingt dix sept", _
"quatre-vingt dix huit", "quatre-vingt dix neuf")
gros = Array("", "billions", "milliards", "millions", "mille", "EUROS", "billion", _
"milliard", "million", "mille", "EURO")
sp = Space(1)
chaine = "00000000000000"
centime = s * 100 - (Int(s) * 100)
s = Str(Int(s)): lg = Len(s) - 1: s = Right(s, lg): lg = Len(s)
If lg < 15 Then chaine = Mid(chaine, 1, (15 - lg)) Else chaine = ""
s = chaine + s
'billions au centaines
gp = 1
For k = 1 To 5
X = Mid(s, gp, 1): C = A(Val(X))
X = Mid(s, gp + 1, 2): d = A(Val(X))
If k = 5 Then
If t2 <> "" And C & d = "" Then mydz = "Euros" & sp: GoTo fin
If T <> "" And C = "" And d = "un" Then mydz = "un euros" & sp: GoTo fin
If T <> "" And t2 = "" And C & d = "" Then mydz = "d'Euros" & sp: GoTo fin
If T & C & d = "" Then myct = "": mydz = "": GoTo fin
End If
If C & d = "" Then GoTo fin
If d = "" And C <> "" And C <> "un" Then mydz = C & sp & "cents " & gros(k) & sp: GoTo fin
If d = "" And C = "un" Then mydz = "cent " & gros(k) & sp: GoTo fin
If d = "un" And C = "" Then myct = IIf(k = 4, gros(k) & sp, "un " & gros(k + 5) & sp): GoTo fin
If d <> "" And C = "un" Then mydz = "cent" & sp
If d <> "" And C <> "" And C <> "un" Then mydz = C & sp & "cent" + sp
myct = d & sp & gros(k) & sp
fin:
t2 = mydz & myct
T = T & mydz & myct
mydz = "": myct = ""
gp = gp + 3
Next
d = A(centime)
If T <> "" Then myct = IIf(centime = 1, " centime", " CENTS")
If T = "" Then myct = IIf(centime = 1, " centime d'Euro", " centimes d'Euro")
If centime = 0 Then d = "": myct = ""
chiffrelettre = T & d & myct
End Function

et ajouter dans la cell de réception

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=chiffrelettre(L28)

"L28" a rectifié bien sur car cette cell recois le chiffre

cordialement

Pascal