Discussion :

[abouhossam]

bjr à tous
j'ai un problème et j'espère trouver la solution chez vous.
est ce qu'il ya sur excel une fonction qui convertie les chiffres en texte
c-à-d
si j'ai la colonne A qui contient les chiffres et je veux que la colonne B m'affiche les chiffres en texte

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
A                            B
1                            un
2                            deux
3                            trois
.
.
.
1000                       mille
.
.
.
.
.
etc

merci bcp.

[Bevan]

Bonjour,
J'avais écrit ça au début des années 90 pour Word 95 je crois ; c'était mes débuts en vba, manquent les dim mais y a plein de commentaires, lol.
Je m'en sert toujours depuis dans Word, Excel et Access... sans problème.

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
'Option Explicit ' non : vieux code word
 
    Const Marquepluriel = "s" 'pour quatre vingts et cents
    Const et = "et " ' pour vingt et un...
    Const De = " d'" ' pour millions et milliards de francs
    Const Zero = "zéro"
    Const Cent = "cent"
 
    Const Unite = "Euro"
    Const Unites = "Euros"
    Const SousUnite = "centime"
    Const SousUnites = "centimes"
    Const Precision = 2
    Const SepDec = ","
 
    Const Separateur = "/"
    Const SUnite = "/un/deux/trois/quatre/cinq/six/sept/huit/neuf/"
    Const SDixUnite = "dix/onze/douze/treize/quatorze/quinze/seize/dix-sept/dix-huit/dix-neuf/"
    Const SDizaine = "//vingt/trente/quarante/cinquante/soixante/soixante/quatre vingt/quatre vingt/"
    Const SPuissance = "/mille/million/milliard///////"
 
    Const MaxTab = 10
    Dim TabUnite(MaxTab)  As String
    Dim TabDixUnite(MaxTab) As String
    Dim TabDizaine(MaxTab) As String
    Dim TabPuissance(MaxTab) As String
 
Sub ChargeTableau(ByVal Source As String, Tableau() As String)
'-----------------------------------------------------------------
' Decompile Source (elements separés par des "separateur")
' et charge les elements dans tableau
'-----------------------------------------------------------------
Dim i As Integer, Pos As Integer, Debut As Integer
 
For i = 0 To MaxTab - 1
    Pos = InStr(Source, Separateur)
    Tableau(i) = Left(Source, Pos - 1)
    Source = Mid(Source, Pos + 1)
Next i
 
End Sub
 
Function Chiffre(n As Integer, Pos As Integer) As Integer
'-----------------------------------------------------------------
' Renvoie le Posième chiffre de n
' Attention : str$(N) contient un espace en tete
'-----------------------------------------------------------------
If Len(Str$(n)) < Pos + 1 Then
   Chiffre = 0
Else
   Chiffre = Val(Left$(Right$(Str$(n), Pos), 1))
End If
 
End Function
 
Public Function Convertir(Chiffre As String) As Variant
'-----------------------------------------------------------------
' Renvoie la chaine représentant chiffre en toutes lettres
' y conpris la partie décimale et les unites
'-----------------------------------------------------------------
 
    Dim w As String
    Dim Entiere As Long, Decimale As Long
    Dim WLettre As String
    Dim PosDec As Integer
 
    'Charge les constantes
    Call ChargeTableau(SUnite, TabUnite())
    Call ChargeTableau(SDixUnite, TabDixUnite())
    Call ChargeTableau(SDizaine, TabDizaine())
    Call ChargeTableau(SPuissance, TabPuissance())
 
    ' recherche le separateur decimal
    PosDec = InStr(Chiffre, SepDec)
    ' extraction partie entiere et partie decimale
    If PosDec = 0 Then ' pas de virgule
        Entiere = Val(Chiffre)
        Decimale = 0
    Else
        Entiere = Val(Left$(Chiffre, PosDec - 1))
        w = Mid$(Chiffre, PosDec + 1)
        ' Ajustement décimales
        ' si il manque des chiffres
        While Len(w) < Precision
           w = w & "0"
        Wend
        ' si il y a trop de chiffres
        w = Left(w, Precision)
        ' et voila
        Decimale = Val(w)
 
    End If
 
    ' conversion partie entiere
    If Entiere = 0 Then
       Wlettres = Zero
    Else
       Wlettres = Lettres(Entiere)
    End If
    If Entiere <= 1 Then
       Wlettres = Wlettres & " " & Unite
    Else
       Wlettres = Wlettres & " " & Unites
    End If
 
    ' conversion des decimales
    If Decimale <> 0 Then
       Wlettres = Wlettres & " et " & Lettres(Decimale)
       If Decimale = 1 Then
          Wlettres = Wlettres & " " & SousUnite
       Else
          Wlettres = Wlettres & " " & SousUnites
       End If
    End If
 
    Convertir = Wlettres
 
End Function
 
Function Lettres(n As Long) As Variant
'-----------------------------------------------------------------
' Renvoie la conversion en toutes lettres de l'entier n
' On traite par paquet de 3 : unité, mille, million, milliard...
' Attention : la valeur 0 doit être traitée en amont
'-----------------------------------------------------------------
 
    Dim i As Integer, Paquet As Integer
    Dim NbPaquet As Integer
    Dim WS As String, Wdeb As String
    Dim triple As Integer
 
    NbPaquet = Int((Len(Str$(n)) - 1) / 3)
    Wdev = ""
 
    For i = 0 To NbPaquet
        'Chaine du triplet
        triple = Triplet(n, i)
        WS = TraiteCentaine(triple)
        'libellé de la puissance de 10
        If i > 0 And WS <> "" Then
           ' Cas particulier : on ne dit pas un mille
           If (i = 1 And triple = 1) Then
               WS = TabPuissance(1)
           Else
               WS = WS & " " & TabPuissance(i)
           End If
           ' cas particulier million ou milliard avec s
           If i >= 2 Then
               If triple > 1 Then
                  WS = WS & Marquepluriel
               End If
               ' et on dit DE francs ou centimes
               If Wdeb = "" Then
                  WS = WS & De
               End If
           End If
        End If
        ' Ajout à la construction
        If WS <> "" Then
           If Wdeb = "" Then
              Wdeb = WS
           Else
              Wdeb = WS & " " & Wdeb
           End If
        End If
    Next i
 
    Lettres = Wdeb
 
End Function
 
Function TraiteCentaine(n As Integer) As String
'-----------------------------------------------------------------
' Renvoie la chaine correspondant à un entier à 3 chiffres
'-----------------------------------------------------------------
    Dim Wdix As String, WS As String
    Dim C2 As Integer
 
    ' D'abord les dizaines
    Wdix = TraiteDizaine(n)
 
    'Puis les centaines
    C2 = Chiffre(n, 3)
    Select Case C2
       Case 0
          WS = ""
       Case 1
          WS = Cent
       Case Else
          WS = TabUnite(C2) & " " & Cent
          If Wdix = "" Then  'Cas du cents
             WS = WS & Marquepluriel
          End If
     End Select
     If WS = "" Then ' pas de centaine
        WS = Wdix
     Else
        If Wdix <> "" Then
            WS = WS & " " & Wdix
        End If
     End If
     TraiteCentaine = WS
End Function
 
Function TraiteDizaine(n As Integer) As String
'-----------------------------------------------------------------
' Renvoie la chaine correspondant aux 2 derniers chiffres de n
'-----------------------------------------------------------------
Dim C0 As Integer, C1 As Integer
Dim WS As String
C0 = Chiffre(n, 1)
C1 = Chiffre(n, 2)
 
'chaine des unités
Select Case C1
   Case 0, 2, 3, 4, 5, 6, 8  ' pas de pb
      WS = TabUnite(C0)
   Case Else '1, 7, 9 : onze, douze...
      WS = TabDixUnite(C0)
End Select
 
'Cas du 1 :
If C0 = 1 Then
   'besoin de "et" pour 21, 31, 41, 51, 61, 71
   Select Case C1 'plus lisible qu'un if
      Case 2, 3, 4, 5, 6, 7
         WS = et & WS
   End Select
End If
If WS = "" Then
  WS = TabDizaine(C1)
Else
  If C1 >= 2 Then 'sinon 1à 19 dejà complet
     WS = TabDizaine(C1) & " " & WS
  End If
End If
' Cas du quatre vingtS
If C1 = 8 And C0 = 0 Then
   WS = WS & Marquepluriel
End If
TraiteDizaine = WS
End Function
 
Function Triplet(n As Long, Pos As Integer) As Integer
'-----------------------------------------------------------------
' renvoie le Posième triplet de n
' Attention : str$(N) contient un espace en tete
'-----------------------------------------------------------------
Dim WS As String
Dim longueur As Integer
 
WS = Mid$(Str$(n), 2)
 
If Len(WS) < Pos * 3 + 1 Then ' on a dépassé
   Triplet = 0
Else
   WS = Right$(WS, (Pos + 1) * 3)
   ' pour le cas du dernier triplet : 1, 2 ou 3 chiffres
   longueur = Len(WS) - Pos * 3
   If longueur > 3 Then
      longueur = 3
   End If
   WS = Left$(WS, longueur)
   Triplet = Val(WS)
End If
 
End Function

[ouskel'n'or]

Il me semble qu'il y a une fonction qui fait ça
Sinon, le code existe tout fait. Regarde déjà dans la FAQ et dans les tutoriels (adresses dans la signature)
De mon côté, je regarde si je trouve.

Trouvé !
Regarde ici, au chapitre "Transformer des chiffres en lettres. Avec décimal ou non"
Bonne journée

[abouhossam]

je cherche la fonction dans excel et pas dans VBA.
j'ai trouvé BAHTTEXT(A1) mais elle donne le resultat en format béta
merci.

[fring]

As-tu simplement fait une recherche sur la fonction BAHTTEXT ?

Je ne pense pas...voici ce que fait cette fonction

Code :

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

Convertit un nombre en texte thaï et ajoute le suffixe "Baht".

Il ne te reste plus qu'à trouver un traducteur thaï-français

Il n'existe pas, à ma connaissance, de fonction préétablie, il faut la bricoler soi même.

[abouhossam]

tous ce que vous disez et just
moi j'ai trouvé la solution ici http://pagesperso-orange.fr/gerard.g...xcel/excel.htm
merci bcp.

[ouskel'n'or]

je cherche la fonction dans excel et pas dans VBA.
j'ai trouvé BAHTTEXT(A1) mais elle donne le resultat en format béta
merci.

Alors ta question aurait dû être posée dans Excel
Mais ta dernière réponse correspond à ce j'avais vu "quelque part"... Il serait bien que tu ajoutes la solution au lien pour les raisons que je t'ai indiquées pas mp.
Merci

[abouhossam]

bjr à tous
merci ouskel'n'or
j'ai bien trouvé un macro et je l'ai dévelopé un peu et voilà le resultat

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
'***********
' Devise=0   aucune
'       =1   Euro €
'       =2   Dollar $
'       =3   Dirham Dh
' 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 Byte = 0, _
                                    Optional Langue 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"
             strCentimes = strCentimes & " Cent"
        Case 2
            strDev = " Dollar"
             strCentimes = strCentimes & " Cent"
        Case 3
            strDev = " Dirham"
            strCentimes = strCentimes & " Centime"
    End Select
If dblEnt = 1 And Devise <> 0 Then
    If byDec = 0 Then
    ConvNumberLetter = ConvNumEnt(CDbl(dblEnt), Langue) & strDev & " et ZERO" & strCentimes
    End If
    If byDec = 1 Then
    ConvNumberLetter = ConvNumEnt(CDbl(dblEnt), Langue) & strDev & " et " & ConvNumDizaine(byDec, Langue) & strCentimes
    End If
    If byDec > 1 Then
    ConvNumberLetter = ConvNumEnt(CDbl(dblEnt), Langue) & strDev & " et " & ConvNumDizaine(byDec, Langue) & strCentimes & "s"
    End If
ElseIf dblEnt > 1 And Devise <> 0 Then
    strDev = strDev & "s "
    If byDec = 0 Then
    ConvNumberLetter = ConvNumEnt(CDbl(dblEnt), Langue) & strDev & " et ZERO" & strCentimes
    End If
    If byDec = 1 Then
    ConvNumberLetter = ConvNumEnt(CDbl(dblEnt), Langue) & strDev & " et " & ConvNumDizaine(byDec, Langue) & strCentimes
    End If
    If byDec > 1 Then
    ConvNumberLetter = ConvNumEnt(CDbl(dblEnt), Langue) & strDev & " et " & ConvNumDizaine(byDec, Langue) & strCentimes & "s"
    End If
Else
    If byDec = 1 Then
    ConvNumberLetter = "ZERO" & strDev & " et " & ConvNumDizaine(byDec, Langue) & strCentimes
    End If
    If byDec > 1 Then
    ConvNumberLetter = "ZERO" & strDev & " et " & ConvNumDizaine(byDec, Langue) & strCentimes & "s"
    End If
End If
End Function
 
Private Function ConvNumEnt(Nombre As Double, Langue As Byte)
    Dim byNum As Byte, iTmp As Variant, dblReste As Double
    Dim strTmp As String
 
    iTmp = Nombre - (Int(Nombre / 1000) * 1000)
    ConvNumEnt = ConvNumCent(CInt(iTmp), Langue)
    dblReste = Int(Nombre / 1000)
    iTmp = dblReste - (Int(dblReste / 1000) * 1000)
    strTmp = ConvNumCent(CInt(iTmp), Langue)
    Select Case iTmp
        Case 0
        Case 1
            strTmp = "mille "
        Case Else
            strTmp = strTmp & " mille "
    End Select
    ConvNumEnt = strTmp & ConvNumEnt
    dblReste = Int(dblReste / 1000)
    iTmp = dblReste - (Int(dblReste / 1000) * 1000)
    strTmp = ConvNumCent(CInt(iTmp), Langue)
    Select Case iTmp
        Case 0
        Case 1
            strTmp = strTmp & " million "
        Case Else
            strTmp = strTmp & " millions "
    End Select
    ConvNumEnt = strTmp & ConvNumEnt
    dblReste = Int(dblReste / 1000)
    iTmp = dblReste - (Int(dblReste / 1000) * 1000)
    strTmp = ConvNumCent(CInt(iTmp), Langue)
    Select Case iTmp
        Case 0
        Case 1
            strTmp = strTmp & " milliard "
        Case Else
            strTmp = strTmp & " milliards "
    End Select
    ConvNumEnt = strTmp & ConvNumEnt
    dblReste = Int(dblReste / 1000)
    iTmp = dblReste - (Int(dblReste / 1000) * 1000)
    strTmp = ConvNumCent(CInt(iTmp), Langue)
    Select Case iTmp
        Case 0
        Case 1
            strTmp = strTmp & " billion "
        Case Else
            strTmp = strTmp & " billions "
    End Select
    ConvNumEnt = strTmp & ConvNumEnt
 
End Function
 
Private Function ConvNumDizaine(Nombre As Byte, Langue As Byte) As String
    Dim TabUnit As Variant, TabDiz As Variant
    Dim byUnit As Byte, byDiz As Byte
    Dim strLiaison As String
 
    TabUnit = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
        "huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", _
        "seize", "dix-sept", "dix-huit", "dix-neuf")
    TabDiz = Array("", "", "vingt", "trente", "quarante", "cinquante", _
        "soixante", "soixante", "quatre-vingt", "quatre-vingt")
    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)
    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

[AlainTech]

Résolu?

!