Discussion :

[SIOUDI]

Bonjour,

Je vous prie d'aider si c'est possible de convertir une chiffre en 03 ch après la virgule en lettres.
exple : 3526,254 = trois milles cinq cent vingt six Dinars, 254 Millimes.


Meilleures Salutations

[Menhir]

Il n'y a pas de solution simple pour y parvenir.
A moins qu'il existe déjà quelque part une macro que quelqu'un aurait développé pour son propre usage et qu'il aurait généreusement mise en téléchargement.

[SIOUDI]

S'il vous plais me servir les liens

[Menhir]

Si j'en avais un, je l'aurais mis dans mon message précédent.

[kiki29]

Salut,Salam,
Sorti des décombres donc à tester + à 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
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

[clementmarcotte]

Bonjour,

Il n'y a pas de solution simple pour y parvenir.
A moins qu'il existe déjà quelque part une macro que quelqu'un aurait développé pour son propre usage et qu'il aurait généreusement mise en téléchargement.

Il y a des liens sur cette page:

http://frederic.sigonneau.free.fr/ToutFait.htm

Elle n'est pas adaptée au dinar, mais ce ne serait pas la mer à boire. Elle est "septantisée", "Wordisée", "Excellisée" et "PowerPointisée".

Clic-droit dans l'Explorateur Windows et Propriétés pour connaître le mot de passe.

[SIOUDI]

Merci à tous

spécialement kiki29

Problème résolu

[omar80]

bonsoir, je viens de trouver ce que je cherche en voyant cette discussion..cependant en insérant le code macro de kiki29 g trouvé qlq erreurs lors de la conversion.
exemple : 123.596 =Cent Vingt-Trois Dinars Cinq Cent Quatre-Vingt-Dix-Six Millimes
au lieu de cinq cent quatre vingt seize millimes
de meme pour 78 936,673=Soixante-Dix-Huit Mille Neuf Cent Trente-Six Dinars Six Cent Soixante-Dix-Trois Millimes
comment je peux modifier le code pour ke ca fonctionne corectement? en fait g contacté kiki29 mais il ne ma pas repondu malheureusement..je ne connais pas la programmation vba mes connaisaance sont limités,personne pourra m'aider svp et merci

[kiki29]

Salut, en reprenant le code tel quel j'obtiens ceci. Le problème vient donc de tes modifs.

[omar80]

Merci de m'avoir repondu,cependant j'ai rien modifié kiki29,je ne maitrise pas la programmation..g juste copier ton code dans mon classeur pour avoir la fonction et pour tester macro.xlsmg trouvé des erreurs comme g raconté hier.bref je te joints en pj mon classeur pour voir mieux les erreurs et me resoudre le probleme et merci d'avance

[kiki29]

Salut, c'est faux toi ou quelqu'un d'autre à cru bon de modifier le code. La preuve une fois de plus, à toi de chercher où de recopier SANS MODIFIER le code fourni.

[omar80]

slt c bizarre je comprends rien de tt,g rien modifié je vous le dit encore une fois (JE NE MAITRISE PAS LA PROGRAMMATION VBA) jvé recopier encore une fois

votre code.si ca ne fonctionne pas correctement alors dans ce cas priere de m'envoyer un fichier excel en pj et comme ca on ferme la parenthèse,je vous tiens au

courant de tte façon

[omar80]

slt c bon g recopié le code et ca fonctionne correctement comme tu ma demandé..juste une derniere chose je te joint un classuer qui contient une macro disant une autre formule qui est : =chiffrelettre($A$24),en fait ma question comment je peux ajouter une 2eme macro c ta dire comment je peux avoir le tien ( la fonction ConvNumberLetter) la rajouter dans ce classeur ci joint et comme ca j'aurai 2 fonctions dans le meme classeur et merci pour la n ieme fois kiki29

[kiki29]

Salut, dans ton classeur, tu bascules sous VBA (ALT+F11), tu ajoutes un module puis tu y colles le code

[omar80]

bsr,Merci à ce forum

spécialement kiki29 vous étiez trés patient avec moi pour m'aider à résoudre ses points dont g besoin dans mon boulot..

[Patrice740]

Bonjour kiki,

Je viens de découvrir ton code, il y a une erreur pour les devises en cents (on obtient des millièmes),
Remplacer la ligne 42 :

Code :

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

    byDec = CInt((Nombre - dblEnt) * 1000)

par :

Code :

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

1
2
3
4
5
    If Devise = 4 Then
      byDec = CInt((Nombre - dblEnt) * 1000)  'millièmes
    Else
      byDec = CInt((Nombre - dblEnt) * 100)   'centièmes
    End If

[jml17]

Bonjour à tous,

Après avoir patiner pas mal de temps sur le sujet, j'ai enfin réussi à intégrer la macro dans mes feuilles de calcul. ouf !
Mais comme je suis un peu, pour ne pas dire complètement nul, j'ai lu qu 'avec excel 2016, il y avait une solution encore plus simple.
Là encore je récapépète, et je récapépète le sujet sans parvenir à une solution.
Quelqu'un aurait-il un tutot simple ?
Deuxième question, toujours sur le même sujet:
- lorsque l'on écrit la formule [I]=ConvNumberLetter(A1;1;0;0;0) dans une somme en euros, le dernier 0 ou 1 correspond aux cents:
1 = mention des cents
0 = pas de cents pour autant qu'il n'y en est pas. C'est à dire que si on des décimales et que l'on sélectionne pas de décimales dans la cellule, excel reconnait quand même la présence de décimales.
Question: y aurait il une ligne de la macro à supprimer ?
Si oui laquelle ?
Quelqu'un a -t-il une solution ?
Merci de vos conseils très éclairés.

[Patrice740]

Bonjour,

Quelqu'un aurait-il un tutot simple ?
Deuxième question, toujours sur le même sujet:
- lorsque l'on écrit la formule [I]=ConvNumberLetter(A1;1;0;0;0) dans une somme en euros, le dernier 0 ou 1 correspond aux cents:
1 = mention des cents
0 = pas de cents pour autant qu'il n'y en est pas. C'est à dire que si on des décimales et que l'on sélectionne pas de décimales dans la cellule, excel reconnait quand même la présence de décimales.
Question: y aurait il une ligne de la macro à supprimer ?
Si oui laquelle ?
Quelqu'un a -t-il une solution ?

1) Le tuto c'est les lignes 3 à 26 du code. Ça me semble très clair, que faut-il de plus ?
2) Pourquoi voudrais-tu supprimer une ligne. le code fonctionne très bien.
Une solution pour résoudre quoi ?
Si c'est pour ne pas afficher des cents qui existent, il suffit de ne pas les envoyer à la fonction [ENT(A1)], mais je veux bien que tu les cumules, et quand il y en aura trop, tu mes les envoies.

[tototiti2008]

Bonjour,

Je ne sais pas si ça peut servir, je pose ça là