Montant en toutes lettres

**BENNASR** · 22/02/2016, 12h05

bonjour tous le monde et bonne et heureuse journée
j'ai trouver sur ce super site un code pour écrire un montant en toutes lettres (en dinars)
mais je crois ça fonctionne sauf si le montant est inférieur à un dinars
il donne "Sept cent soixante et onze" au lieu de "Sept cent soixante et onze millimes" ou bien : "zéro dinars et Sept cent soixante et onze millimes"
merci pour l'aide

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

**kiki29** · 22/02/2016, 12h20

Salut, avec 2 décimales, à tester plus à fond

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
Option Explicit
 
'-----------------------------------------------------------------------------
'     Devise    =0   aucune
'               =1   Dinar TND
'               =2   Dollar $
'------------------------------
'     Langue    =0   Français
'               =1   Belgique
'               =2   Suisse
'-----------------------------------------------------------------------------
'
'   Conversion limitée à 999 999 999 999 999 ou 9 999 999 999 999,99
'   si le nombre contient plus de 2 décimales, il est arrondit à 2 décimales
'
'-----------------------------------------------------------------------------
 
Public Function ConvNumberLetter(Nombre As Double, Optional Devise As Long = 0, _
                                 Optional Langue As Long = 0) As String
Dim dblEnt As Variant, byDec As Long
Dim bNegatif As Boolean
Dim strDev As String, strCentimes As String
 
    If Nombre < 0 Then
        bNegatif = True
        Nombre = Abs(Nombre)
    End If
 
    dblEnt = Int(Nombre)
    byDec = CInt((Nombre - dblEnt) * 100)
    If byDec = 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 byDec > 0 Then strDev = " virgule "
        Case 1
            strDev = " Dinar"
            If dblEnt >= 1000000 And Right$(dblEnt, 6) = "000000" Then strDev = " de Dinar"
            If byDec > 0 Then strCentimes = strCentimes & " Millime"
            If byDec > 1 Then strCentimes = strCentimes & "s"
        Case 2
            strDev = " Dollar"
            If byDec > 0 Then strCentimes = strCentimes & " Cent"
    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 byDec = 0 Then
        If Devise <> 0 Then ConvNumberLetter = ConvNumberLetter & "zéro Millime"
    Else
        If Devise = 0 Then
            ConvNumberLetter = ConvNumberLetter & _
                               ConvNumDizaine(byDec, Langue, True) & strCentimes
        Else
            ConvNumberLetter = ConvNumberLetter & _
                               ConvNumDizaine(byDec, Langue, False) & strCentimes
        End If
    End If
    ConvNumberLetter = Replace(ConvNumberLetter, "  ", " ")
    If Left(ConvNumberLetter, 1) = " " Then ConvNumberLetter = _
       Right$(ConvNumberLetter, Len(ConvNumberLetter) - 1)
    If Right$(ConvNumberLetter, 1) = " " Then ConvNumberLetter = _
       Left(ConvNumberLetter, Len(ConvNumberLetter) - 1)
End Function
 
Private Function ConvNumEnt(Nombre As Double, Langue As Long)
Dim iTmp As Variant, dblReste As Double
Dim strTmp As String
Dim iCent As Integer, iMille As Integer, iMillion As Integer
Dim iMilliard As Integer, iBillion As Integer
 
    iTmp = Nombre - (Int(Nombre / 1000) * 1000)
    iCent = CInt(iTmp)
    ConvNumEnt = Nz(ConvNumCent(iCent, Langue))
    dblReste = Int(Nombre / 1000)
    If iTmp = 0 And dblReste = 0 Then Exit Function
    iTmp = dblReste - (Int(dblReste / 1000) * 1000)
    If iTmp = 0 And dblReste = 0 Then Exit Function
    iMille = CInt(iTmp)
    strTmp = ConvNumCent(iMille, Langue)
    Select Case iTmp
        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)
    iTmp = dblReste - (Int(dblReste / 1000) * 1000)
    If iTmp = 0 And dblReste = 0 Then Exit Function
    iMillion = CInt(iTmp)
    strTmp = ConvNumCent(iMillion, Langue)
    Select Case iTmp
        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)
    iTmp = dblReste - (Int(dblReste / 1000) * 1000)
    If iTmp = 0 And dblReste = 0 Then Exit Function
    iMilliard = CInt(iTmp)
    strTmp = ConvNumCent(iMilliard, Langue)
    Select Case iTmp
        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)
    iTmp = dblReste - (Int(dblReste / 1000) * 1000)
    If iTmp = 0 And dblReste = 0 Then Exit Function
    iBillion = CInt(iTmp)
    strTmp = ConvNumCent(iBillion, Langue)
    Select Case iTmp
        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 ConvNumDizaine(Nombre As Long, Langue As Long, bDec As Boolean) As String
Dim TabUnit As Variant, TabDiz As Variant
Dim byUnit As Long, byDiz As Long
Dim strLiaison As String
 
    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
    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
    byDiz = Int(Nombre / 10)
    byUnit = Nombre - (byDiz * 10)
    strLiaison = "-"
    If byUnit = 1 Then strLiaison = " et "
    Select Case byDiz
        Case 0
            strLiaison = " "
        Case 1
            byUnit = byUnit + 10
            strLiaison = ""
        Case 7
            If Langue = 0 Then byUnit = byUnit + 10
        Case 8
            If Langue <> 2 Then strLiaison = "-"
        Case 9
            If Langue = 0 Then
                byUnit = byUnit + 10
                strLiaison = "-"
            End If
    End Select
    ConvNumDizaine = TabDiz(byDiz)
    If byDiz = 8 And Langue <> 2 And byUnit = 0 Then ConvNumDizaine = ConvNumDizaine & "s"
    If TabUnit(byUnit) <> "" Then
        ConvNumDizaine = ConvNumDizaine & strLiaison & TabUnit(byUnit)
    Else
        ConvNumDizaine = ConvNumDizaine
    End If
End Function
 
Private Function ConvNumCent(Nombre As Integer, Langue As Long) As String
Dim TabUnit As Variant
Dim byCent As Long, byReste As Long
Dim strReste As String
 
    TabUnit = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
                    "huit", "neuf", "dix")
    byCent = Int(Nombre / 100)
    byReste = Nombre - (byCent * 100)
    strReste = ConvNumDizaine(byReste, Langue, False)
    Select Case byCent
        Case 0
            ConvNumCent = strReste
        Case 1
            If byReste = 0 Then
                ConvNumCent = "cent"
            Else
                ConvNumCent = "cent " & strReste
            End If
        Case Else
            If byReste = 0 Then
                ConvNumCent = TabUnit(byCent) & " cents"
            Else
                ConvNumCent = TabUnit(byCent) & " cent " & strReste
            End If
    End Select
End Function
 
Private Function Nz(strNb As String) As String
    If strNb <> " zéro" Then Nz = strNb
End Function

**BENNASR** · 22/02/2016, 12h45

merci pour la réponse
ConvNumberLetter(G35;1;0)
ça donne : zéro dinars soixante dix sept millime au lieu de zéro dinars sept cent soixante et onze millimes

**kiki29** · 22/02/2016, 14h05

Re, normal car arrondi à 2 décimales, une autre à tester avec 3 décimales max. A toi de l'adapter à ton contexte.

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
Option Explicit
 
'-------------------------------------------------------------------------
'
'   Devise      =0   Aucune
'               =1   Euro           €
'               =2   Dollar         $
'               =3   €uro           €
'               =4   Dinar Tunisien Dt
'
'   Langue      =0   Français
'               =1   Belge
'               =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
' si le nombre contient plus de 2 décimales,il est arrondit à 3 décimales
'-------------------------------------------------------------------------
 
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 Variant, byDec As Long
Dim bNegatif As Boolean
Dim strDev As String, strCentimes As String
 
    If Nombre < 0 Then
        bNegatif = True
        Nombre = Abs(Nombre)
    End If
 
    dblEnt = Int(Nombre)
    byDec = CInt((Nombre - dblEnt) * 1000)
    If byDec = 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 byDec > 0 Then strDev = " virgule "
        Case 1
            strDev = " Euro"
            If dblEnt >= 1000000 And Right$(dblEnt, 6) = "000000" Then strDev = " d'Euro"
            If byDec > 0 Then strCentimes = strCentimes & " Cent"
            If byDec > 1 Then strCentimes = strCentimes & "s"
        Case 2
            strDev = " Dollar"
            If byDec > 0 Then strCentimes = strCentimes & " Cent"
        Case 3
            strDev = " €uro"
            If dblEnt >= 1000000 And Right$(dblEnt, 6) = "000000" Then strDev = " d'€uro"
            If byDec > 0 Then strCentimes = strCentimes & " Cent"
            If byDec > 1 Then strCentimes = strCentimes & "s"
        Case 4
            strDev = " Dt"
            If dblEnt >= 1000000 And Right$(dblEnt, 6) = "000000" Then strDev = " de Dinars Tunisiens"
            If byDec > 0 Then strCentimes = strCentimes & " Millime"
            If byDec > 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 byDec = 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(byDec, Langue) & strCentimes
        Else
            ConvNumberLetter = ConvNumberLetter & ConvNumCent(byDec, Langue) & strCentimes
        End If
    End If
 
    ConvNumberLetter = Replace(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 ConvNumEnt(Nombre As Double, Langue As Long)
Dim iTmp As Variant, dblReste As Double
Dim strTmp As String
Dim iCent As Long, iMille As Long, iMillion As Long
Dim iMilliard As Long, iBillion As Long
 
    iTmp = Nombre - (Int(Nombre / 1000) * 1000)
    iCent = CInt(iTmp)
    ConvNumEnt = Nz(ConvNumCent(iCent, Langue))
    dblReste = Int(Nombre / 1000)
    If iTmp = 0 And dblReste = 0 Then Exit Function
    iTmp = dblReste - (Int(dblReste / 1000) * 1000)
    If iTmp = 0 And dblReste = 0 Then Exit Function
    iMille = CInt(iTmp)
    strTmp = ConvNumCent(iMille, Langue)
 
    Select Case iTmp
        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)
    iTmp = dblReste - (Int(dblReste / 1000) * 1000)
    If iTmp = 0 And dblReste = 0 Then Exit Function
    iMillion = CInt(iTmp)
    strTmp = ConvNumCent(iMillion, Langue)
 
    Select Case iTmp
        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)
    iTmp = dblReste - (Int(dblReste / 1000) * 1000)
    If iTmp = 0 And dblReste = 0 Then Exit Function
    iMilliard = CInt(iTmp)
    strTmp = ConvNumCent(iMilliard, Langue)
 
    Select Case iTmp
        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)
    iTmp = dblReste - (Int(dblReste / 1000) * 1000)
    If iTmp = 0 And dblReste = 0 Then Exit Function
    iBillion = CInt(iTmp)
    strTmp = ConvNumCent(iBillion, Langue)
 
    Select Case iTmp
        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 ConvNumDizaine(Nombre As Long, Langue As Long, bDec As Boolean) As String
Dim TabUnit As Variant, TabDiz As Variant
Dim byUnit As Long, byDiz As Long
Dim strLiaison As String
 
    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
 
    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
 
    byDiz = Int(Nombre / 10)
    byUnit = Nombre - (byDiz * 10)
    strLiaison = "-"
    If byUnit = 1 Then strLiaison = " et "
 
    Select Case byDiz
        Case 0
            strLiaison = " "
        Case 1
            byUnit = byUnit + 10
            strLiaison = ""
        Case 7
            If Langue = 0 Then byUnit = byUnit + 10
        Case 8
            If Langue <> 2 Then strLiaison = "-"
        Case 9
            If Langue = 0 Then
                byUnit = byUnit + 10
                strLiaison = "-"
            End If
    End Select
 
    ConvNumDizaine = TabDiz(byDiz)
    If byDiz = 8 And Langue <> 2 And byUnit = 0 Then ConvNumDizaine = ConvNumDizaine & "s"
    If TabUnit(byUnit) <> "" Then
        ConvNumDizaine = ConvNumDizaine & strLiaison & TabUnit(byUnit)
    Else
        ConvNumDizaine = ConvNumDizaine
    End If
End Function
 
Private Function ConvNumCent(Nombre As Long, Langue As Long) As String
Dim TabUnit As Variant
Dim byCent As Long, byReste As Long
Dim strReste As String
 
    TabUnit = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
                    "huit", "neuf", "dix")
    byCent = Int(Nombre / 100)
    byReste = Nombre - (byCent * 100)
    strReste = ConvNumDizaine(byReste, Langue, False)
 
    Select Case byCent
        Case 0
            ConvNumCent = strReste
        Case 1
            If byReste = 0 Then
                ConvNumCent = "cent"
            Else
                ConvNumCent = "cent " & strReste
            End If
        Case Else
            If byReste = 0 Then
                ConvNumCent = TabUnit(byCent) & " cents"
            Else
                ConvNumCent = TabUnit(byCent) & " cent " & strReste
            End If
    End Select
End Function
 
Private Function Nz(strNb As String) As String
    If strNb <> " zéro" Then Nz = strNb
End Function

**BENNASR** · 22/02/2016, 15h13

Merci KIKI29
ça fonctionne à merveille
bonne journée

Montant en toutes lettres [XL-2010]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager