Discussion :

[zinelamri]

Bonjour,

J'ai un problème et je veux que vous m'aider
J'aimerais transformer chiffres en lettre avec un bouton dans excel, par exemple j'écris le chiffre ensuite je appuyer sur le bouton le résultat s’affiche dans le case souhaité .


Des explications dans le fichier que vous joins.
Je vous remercie d'avance pour votre aide



Merci d'avance.
cordialement

[Marc-L]

Bonjour,

sujet déjà traité ici comme dans la section Contribuez, via une simple recherche …

___________________________________________________________________________________________________________

Je suis Paris, Barcelone, London, Manchester, Egypte, Stockholm, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

[zinelamri]

Bonjour,

merci pour votre attention
Quatre jour de recherche, plus de 20 fiches télécharger j'ai pas trouvé ce que je recherche.
sauf dans cites en anglais, sauf dans cites en anglais j'ai trouvé ça

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
Sub sumit()
 
 
    Dim mainWorkBook
 
    Set mainWorkBook = ActiveWorkbook
 
 
    intRows = mainWorkBook.Sheets("Main").UsedRange.Rows.Count
    'MsgBox intRows
    For i = 1 To intRows
    intValue = mainWorkBook.Sheets("Main").Range("A" & i)
       If intValue <> "" Then
            mainWorkBook.Sheets("Main").Range("B" & i) = FnConvert(intValue)
       End If
    Next
 
 
 
End Sub
Function FnConvert(strNumber)
 
    blnDecimalExist = False
    strNumber = CStr(strNumber)
 
    If InStr(1, strNumber, ".", vbTextCompare) > 0 Then
        arrSplit = Split(strNumber, ".")
        strNumber = arrSplit(0)
        strDecimal = arrSplit(1)
 
        If Len(strDecimal) > 2 Then
            strDecimal = Mid(strDecimal, 0, 2)
        End If
 
        If Len(strDecimal) > 0 And Len(strDecimal) < 2 Then
            strDecimalConversion = FnGetUnitDigit(strDecimal)
        End If
        If Len(strDecimal) > 1 And Len(strDecimal) < 3 Then
            strDecimalConversion = FnGetTensDigit(strDecimal)
        End If
 
        blnDecimalExist = True
 
    End If
 
    If Len(strNumber) > 0 And Len(strNumber) < 2 Then
        strTextConversion = FnGetUnitDigit(strNumber)
    End If
    If Len(strNumber) > 1 And Len(strNumber) < 3 Then
        strTextConversion = FnGetTensDigit(strNumber)
    End If
    If Len(strNumber) > 2 And Len(strNumber) < 4 Then
        strTextConversion = FnGetHundreds(strNumber)
    End If
    If Len(strNumber) > 3 And Len(strNumber) < 6 Then
        If Len(strNumber) = 4 Then
            strTextConversion = FnGetThousandsOne(strNumber)
        End If
        If Len(strNumber) = 5 Then
            strTextConversion = FnGetThousandsTwo(strNumber)
        End If
    End If
     If Len(strNumber) > 5 And Len(strNumber) < 8 Then
       If Len(strNumber) = 6 Then
            strTextConversion = FnGetLacsOne(strNumber)
        End If
        If Len(strNumber) = 7 Then
            strTextConversion = FnGetLacsTwo(strNumber)
        End If
    End If
    If Len(strNumber) > 7 And Len(strNumber) < 15 Then
       If Len(strNumber) = 8 Then
            strTextConversion = FnGetCroreOne(strNumber)
        End If
        If Len(strNumber) = 9 Then
            strTextConversion = FnGetCroreTwo(strNumber)
        End If
        If Len(strNumber) = 10 Then
            strTextConversion = FnGetCroreThree(strNumber)
        End If
        If Len(strNumber) = 11 Then
            strTextConversion = FnGetCroreFour(strNumber)
        End If
        If Len(strNumber) = 12 Then
            strTextConversion = FnGetCroreFive(strNumber)
        End If
        If Len(strNumber) = 13 Then
            strTextConversion = FnGetCroreSix(strNumber)
        End If
        If Len(strNumber) = 14 Then
            strTextConversion = FnGetCroreSeven(strNumber)
        End If
    End If
 
 
    If blnDecimalExist Then
        strTextConversion = "Rupees " & strTextConversion & " and " & strDecimalConversion & " paise only"
    Else
        strTextConversion = "Rupees " & strTextConversion
    End If
    FnConvert = strTextConversion
End Function
Function FnGetCroreSeven(intN)
    Dim Str
 
    'temp = FnGetTensDigit(Left(intN, 3))
    'If temp <> "" Then
        Str = FnGetLacsTwo(Left(intN, 7)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 7))
    'Else
     '   Str = FnGetLacsTwo(Right(intN, Len(intN) - 3))
    'End If
    FnGetCroreSeven = Str
End Function
 
Function FnGetCroreSix(intN)
    Dim Str
 
    'temp = FnGetTensDigit(Left(intN, 3))
    'If temp <> "" Then
        Str = FnGetLacsOne(Left(intN, 6)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 6))
    'Else
     '   Str = FnGetLacsTwo(Right(intN, Len(intN) - 3))
    'End If
    FnGetCroreSix = Str
End Function
 
Function FnGetCroreFive(intN)
    Dim Str
 
    'temp = FnGetTensDigit(Left(intN, 3))
    'If temp <> "" Then
        Str = FnGetThousandsTwo(Left(intN, 5)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 5))
    'Else
     '   Str = FnGetLacsTwo(Right(intN, Len(intN) - 3))
    'End If
    FnGetCroreFive = Str
End Function
 
Function FnGetCroreFour(intN)
    Dim Str
 
    'temp = FnGetTensDigit(Left(intN, 3))
    'If temp <> "" Then
        Str = FnGetThousandsOne(Left(intN, 4)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 4))
    'Else
     '   Str = FnGetLacsTwo(Right(intN, Len(intN) - 3))
    'End If
    FnGetCroreFour = Str
End Function
 
Function FnGetCroreThree(intN)
    Dim Str
 
    'temp = FnGetTensDigit(Left(intN, 3))
    'If temp <> "" Then
        Str = FnGetHundreds(Left(intN, 3)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 3))
    'Else
     '   Str = FnGetLacsTwo(Right(intN, Len(intN) - 3))
    'End If
    FnGetCroreThree = Str
End Function
 
Function FnGetCroreTwo(intN)
    Dim Str
 
    temp = FnGetTensDigit(Left(intN, 2))
    If temp <> "" Then
        Str = FnGetTensDigit(Left(intN, 2)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 2))
    Else
        Str = FnGetLacsTwo(Right(intN, Len(intN) - 2))
    End If
 
    FnGetCroreTwo = Str
End Function
 
Function FnGetCroreOne(intN)
    Dim Str
 
    temp = FnGetUnitDigit(Left(intN, 1))
    If temp <> "" Then
        Str = FnGetUnitDigit(Left(intN, 1)) & " Crore " & FnGetLacsTwo(Right(intN, Len(intN) - 1))
    Else
        Str = FnGetLacsTwo(Right(intN, Len(intN) - 1))
    End If
 
     FnGetCroreOne = Str
End Function
Function FnGetLacsTwo(intN)
    Dim Str
 
    temp = FnGetTensDigit(Left(intN, 2))
    If temp <> "" Then
        Str = FnGetTensDigit(Left(intN, 2)) & " Lacs " & FnGetThousandsTwo(Right(intN, Len(intN) - 2))
    Else
        Str = FnGetThousandsTwo(Right(intN, Len(intN) - 2))
    End If
 
    FnGetLacsTwo = Str
End Function
Function FnGetLacsOne(intN)
    Dim Str
     'Str = FnGetUnitDigit(Left(intN, 1)) & " Lac " & FnGetThousandsTwo(Right(intN, Len(intN) - 1))
 
    temp = FnGetUnitDigit(Left(intN, 1))
    If temp <> "" Then
        Str = FnGetUnitDigit(Left(intN, 1)) & " Lac " & FnGetThousandsTwo(Right(intN, Len(intN) - 1))
    Else
        Str = FnGetThousandsTwo(Right(intN, Len(intN) - 1))
    End If
 
 
     FnGetLacsOne = Str
End Function
Function FnGetThousandsTwo(intN)
    Dim Str
    'Str = FnGetTensDigit(Left(intN, 2)) & " Thousand " & FnGetHundreds(Right(intN, Len(intN) - 2))
 
    temp = FnGetTensDigit(Left(intN, 2))
    If temp <> "" Then
        Str = FnGetTensDigit(Left(intN, 2)) & " Thousand " & FnGetHundreds(Right(intN, Len(intN) - 2))
    Else
        Str = FnGetHundreds(Right(intN, Len(intN) - 2))
    End If
 
 
    FnGetThousandsTwo = Str
End Function
Function FnGetThousandsOne(intN)
    Dim Str
    'Str = FnGetUnitDigit(Left(intN, 1)) & " Thousand " & FnGetHundreds(Right(intN, Len(intN) - 1))
 
    temp = FnGetUnitDigit(Left(intN, 1))
    If temp <> "" Then
        Str = FnGetUnitDigit(Left(intN, 1)) & " Thousand " & FnGetHundreds(Right(intN, Len(intN) - 1))
    Else
        Str = FnGetHundreds(Right(intN, Len(intN) - 1))
    End If
 
    FnGetThousandsOne = Str
End Function
Function FnGetHundreds(intN)
    Dim Str
    temp = FnGetUnitDigit(Left(intN, 1))
    If temp <> "" Then
        Str = FnGetUnitDigit(Left(intN, 1)) & " Hundred " & FnGetTensDigit(Right(intN, 2))
    Else
        Str = FnGetTensDigit(Right(intN, 2))
    End If
 
    FnGetHundreds = Trim(Str)
End Function
Function FnGetTensDigit(intN)
    Dim Str
    If Left(intN, 1) = 1 Then
       Select Case Val(intN)
            Case 10: Str = "Ten"
            Case 11: Str = "Eleven"
            Case 12: Str = "Twelve"
            Case 13: Str = "Thirteen"
            Case 14: Str = "Fourteen"
            Case 15: Str = "Fifteen"
            Case 16: Str = "Sixteen"
            Case 17: Str = "Seventeen"
            Case 18: Str = "Eighteen"
            Case 19: Str = "Nineteen"
        End Select
    Else
        Select Case Val(Left(intN, 1))
            Case 2: Str = "Twenty"
            Case 3: Str = "Thirty"
            Case 4: Str = "Fourty"
            Case 5: Str = "Fifty"
            Case 6: Str = "Sixty"
            Case 7: Str = "Seventy"
            Case 8: Str = "Eighty"
            Case 9: Str = "Ninty"
        End Select
 
        Str = Str & " " & FnGetUnitDigit(Right(intN, 1))
    End If
 
    FnGetTensDigit = Trim(Str)
End Function
Function FnGetUnitDigit(intN)
 
    Dim Str
 
    Select Case Val(intN)
        Case 1: Str = "One"
        Case 2: Str = "Two"
        Case 3: Str = "Three"
        Case 4: Str = "Four"
        Case 5: Str = "Five"
        Case 6: Str = "Six"
        Case 7: Str = "Seven"
        Case 8: Str = "Eight"
        Case 9: Str = "Nine"
    End Select
        FnGetUnitDigit = Trim(Str)
End Function

--------------------------------------
veuillez voir la pièce jointe

[pijaku]

Bonjour,

Sur que t'as du chercher longtemps...
En deuxième page du forum contribuez :
https://www.developpez.net/forums/d1...ographe-nikel/

[Marc-L]

Oui aucune recherche car déjà ici il y a pourtant plusieurs exemples ! …

[zinelamri]

Re-bonjour,
bonjour pijaku

Le problème c'est pas dans le code "Chiffres en lettres", c'est comment remplacer la fonction par bouton.

[Daranc]

ton bouton doit appeler la fonction en VBA mais ta cellule doit d'abord être pointée
1) sélectionner la cellule contenant le chiffre
2) appuyer sur le bouton
2-1 relevé en VBA la valeur nombre de ta cellule
2-2 traité le nombre avec la fonction
2-3 écrire le résultat en écrasant le contenu de la cellule
tout le reste nécessaire t'as été donné dans les messages précédents

[zinelamri]

bonjour Daranc

merci Daranc pour toutes ces explications

si vous ajoutez à un petit exemple pour bien comprendre.

[Daranc]

donc un petit exemple mais petit petit

Code :

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

1
2
3
4
5
6
7
Sub exemple()
' bon je vais pas me taper toute la macro Chiffre en lettre donc
Dim t As Long
t = ActiveCell.Value
t = (t / 2) ^ 3 'je vais pas trop me complexifier la macro non plus
ActiveCell.Value = t
End Sub

naturellement il faudra changer la variable pour que ce soit du texte que tu place dans ta cellule
j'oubliais, affecter la macro à un bouton

[zinelamri]

Bonjour
j'ai rien compris

désolé je suis novice en VBA, si c'est possible de vous insérer le code.

Merci

[unparia]

Bonjour

désolé je suis nocive en VBA

Houla ! ne touche plus rien. La nocivité peut tout endommager.

[zinelamri]

Je veux dire débutant novice...débutant

[patricktoulon]

bonjour a tous
il serait intéressant d'ajouter 2 array (Anglos saxon) a mes 2 array Français et d'ajouter un nouvelle argument optional a la fonction (FR/US) dans ma contrib
qui c'est qui veux s'y coller?

[Invité]

il est complètement abérant de s'attaquer à ce genre de problème en langage spaghetti! bon courage!

Code BENNASR sens formule n'y fonction! :

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

1
2
3
 
Sheets("Facture").Range("C57").formulaR1C1= "=ConvNumberLetter(R[-5]C[3],4,0,4,0)"
Sheets("Facture").Range("C57").value=Sheets("Facture").Range("C57").value

[Invité]

Bonjour,
la conversion de valeur numériques en lettres n'est pas chose banale!

si tu regarde le temps passé par Patrick pour finaliser sa méthode de conversion ne t’étonnes pas si il n'y a pas pléthore de contributeur pour disserter sur le sujet!

https://www.developpez.net/forums/d1...s/#post9599015

[BENNASR]

RE
si tu insiste de passer par VBA ajoute simplement ça en fin de ton code

Code :

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

1
2
Formule = "=ConvNumberLetter(R[-5]C[3],4,0,4,0)"
Sheets("Facture").Range("C57").Value = Formule

[Daranc]

Classeur2.xlsm
le classeur à un bouton et il change le chiffre en lettre avec des fonctions réalisées par Thierry Poutrier
merci de respecter son travail ( je n'ai rien sélectionner , j'ai mis l'ensemble de sa démo dans le module)

[zinelamri]

Re bonjour Daranc

L'idée a commencé à se concrétiser peu à peu
le chiffre et le résultat doit être dans des cellules fixe
par exemple le montant dans la cellule ''H21'', et le résultats dans la cellule ''B28''

Je te renvoie le fichier et le code vba pour éclairer plus
le code

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
Option Explicit
 
 
'***********
' Devise=0   aucune
'       =1   Euro €
'       =2   Dollar $
'       =3   €uro €
' 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
' si le nombre contient plus de 2 décimales, il est arrondit à 2 décimales
 
 
Public Function ConvNumberLetter(Nombre As Double, Optional Devise As Byte = 0, _
                                    Optional Langue As Byte = 0, _
                                    Optional Casse As Byte = 0, _
                                    Optional ZeroCent As Byte = 0) As String
    Dim dblEnt As Variant, byDec As Byte
    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 = " 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"
    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 ConvNumberLetter = ConvNumberLetter & "zéro Cent"
        End If
    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)
    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 Byte)
    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 Byte, Langue As Byte, bDec As Boolean) As String
    Dim TabUnit As Variant, TabDiz As Variant
    Dim byUnit As Byte, byDiz As Byte
    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 Byte) As String
    Dim TabUnit As Variant
    Dim byCent As Byte, byReste As Byte
    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

--------
le fichier

merci beaucoup pour votre aide
amicalement

[kiki29]

Salut, pour info : ici ou là

P.-S. : Balise ton code

[Daranc]

si c'est pour mettre dans des cellules fixe, je ne vois pas l’intérêt de mettre une action par code VBA, la formule de feuille est suffisante.

Code :

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

B28 = formule(H21

)
et si tu veux que le calcul ne se fasse que lorsque tu le demande désactive le calcul automatique et tapes F9 pour le lancer manuellement.
Quant à la modif, je pense que tu as assez de matière pour pouvoir chercher un peu la solution.
nous sommes sur un forum d'entraide pas de travail à façon.
Si vraiment tu n'arrives à rien on reverra à ce moment