Utiliser une macro Excel sous access

Version imprimable

[Résolu]Utiliser une macro Excel sous access

Bonjour, je possède une macro excel qui transforme un montant en chiffre en lettres.
la formule utilisée sous excel est =chiffreslettres$A$1
la macro est la suivante :

Code:

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", " centimes")
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

l'interet de cette macro est que lorsque l'on tape un montant (en chiffres) dans un champ, le montant écrit en toutes lettres aparait (après validation) dans un autre champ. Mais je ne sais pas comment l'executer sous access.
Merci . Manu
EDIT : j'ai essayé avec ceci

Code:

1
2
3
Private Sub Texte673_LostFocus()
Me.Texte675 = chiffrelettre(Me.Texte673.Value)
End Sub

mais ca ne fonctionne pas (incompatibilité de type)

Hello !

Je me suis un peu cassé les dents pour les mêmes raisons que toi puis j'ai bidouillé et j'ai trouvé quelque chose (certainement pas vraiment gracieux...) mais qui fonctionne :

Voici mon code (le tien, très très légèrement modifié à la fin et restructuré):

Code:

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
Option Compare Database
Public strLettres   As String
 
Public Function ChiffreLettres(s As String) As String
Dim a       As Variant
Dim 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 aux 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", " centimes")
    If t = "" Then myct = IIf(centime = 1, " centime d'Euro", " centimes d'Euro")
    If centime = 0 Then d = "": myct = ""
 
    strLettres = t & d & myct
 
End Function

Puis pour activer cette nouvelle fonction, sur l'évènement MAJ de mon champ nommé "Chiffre" (le champ de destination étant "Lettres", ces deux lignes :

Code:

1
2
3
4
Private Sub Chiffre_AfterUpdate()
    Call ChiffreLettres(Me!Chiffre)
    Me.Lettres = strLettres
End Sub

Voilà !

C'est intéressant cette fonction.. et ça en jette :mouarf:

26/08/2007, 17h31
FreeAccess

Bonjour,

Il existe également une fonction toute faites dans la :faq:....;)
http://access.developpez.com/sources...ffresEnLettres

Bonne lecture...
26/08/2007, 17h39
bernardmichel

Hello FreeAccess !

J'ai fait bonne lecture... Merci à toi d'avoir réalisé cette fonction, elle est superbe ! :king:
27/08/2007, 19h08
FreeAccess

Citation:

Envoyé par bernardmichel

Hello FreeAccess !

J'ai fait bonne lecture... Merci à toi d'avoir réalisé cette fonction, elle est superbe ! :king:

Houla....ce n'est pas moi qu'il faut remercier.....;);).....mais plutôt l'auteur de cette contribution..:)
Moi, je n'ai fais que signaler que cette fonction existait déjà dans la :faq:
"Rendons à César ce qui appartient à César....."
27/08/2007, 19h48
Manu59410

Merci beaucoup à tous ceux qui m'ont répondu.
problème résolu.
Manu

donc, pour la macro c'est bon mais j'ai toujour un souci pour la faire fonctionner dans mon formulaire :(
lorsque je tape un chiffre, et après que je valide par entrée ou tab, rien ne se passe dans ma case Lettres :(:(
EDIT : maintenant, j'ai modifié un peu ti peux et maintenant, j'ai le meme chiffre que j'ai tapé dans chiffres et dans lettres qui aparaissent
RE-EDIT : bon bah ca roule j'ai remodifié la macro et j'ai utilisé un peu de tout ce que vous m'aviez donné et ca marche donc merci
solution : tout au début de la page de code :

Code:

1
2
3
4
Option Compare Database
Dim mot$(25), Résultat$, N$
Dim Virgule, B, K$, nombre$, longueur
Dim cdu$, C$, D$, U$, Et, Tiret

ensuite les fonctions de la FAQ :

Code:

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
Sub Ajoute(MotSimple$)
'--- ajoute un nouveau terme traduit à la chaine résultat
If Résultat$ <> "" Then
'--- vérifie s'il est nécessaire de coller le nouveau terme au
'--- précédent dans le cas des "S" à rajouter, ou des tirets
If Right$(Résultat$, 1) = "-" Or _
MotSimple$ = "s" Or MotSimple$ = "-" Then
Résultat$ = Résultat$ + MotSimple$
'--- sinon, ajoute le terme après un espace
Else
Résultat$ = Résultat$ + " " + MotSimple$
End If
Else
Résultat$ = MotSimple$
End If
End Sub
 
 
Function Equivalent$(Valeur)
'--- recherche le mot équivalent à une valeur numérique
Select Case Valeur
Case Is < 21
Equivalent$ = mot$(Valeur)
Case Else
Equivalent$ = mot$(18 + (Valeur / 10))
End Select
End Function
 
 
Function Nb2Mot$(Valeur$)
Dim a$
'--- initialisation du tableau contenant les mots interprétés
mot$(1) = "un"
mot$(2) = "deux"
mot$(3) = "trois"
mot$(4) = "quatre"
mot$(5) = "cinq"
mot$(6) = "six"
mot$(7) = "sept"
mot$(8) = "huit"
mot$(9) = "neuf"
mot$(10) = "dix"
mot$(11) = "onze"
mot$(12) = "douze"
mot$(13) = "treize"
mot$(14) = "quatorze"
mot$(15) = "quinze"
mot$(16) = "seize"
mot$(20) = "vingt"
mot$(21) = "trente"
mot$(22) = "quarante"
mot$(23) = "cinquante"
mot$(24) = "soixante"
'--- récupération de paramètre passé
a$ = Valeur$ + " "
'--- initialisation des variables de travail
N$ = ""
Virgule = 0
Résultat$ = ""
'--- pour toute la longueur de celui-ci
For B = 1 To Len(a$)
'--- on extrait chacun de ses caractères
K$ = Mid$(a$, B, 1)
Select Case K$
'--- gère les montants négatifs
Case "-"
Ajoute "moins"
'--- si ceux-ci sont numériques, on batit la chaine n$
Case "0" To "9"
N$ = N$ + K$
'--- sinon, on teste si on est arrivé à une virgule
Case Else
If Virgule = 1 Then
'--- les centimes sont comptés sur 2 digits, réajustés de
'--- manière inverse aux euros, puisqu'on lit les unités
'--- et dizaines de manière inversée (0,2? = 20c et
'--- 0,02?=2c)
N$ = Right$("000" + Left$(N$ + "000", 2), 2)
If Val(N$) = 0 Then N$ = ""
End If
'--- on traduit le nombre stocké dans n$
TraduireEntier N$
'--- puis on détermine son unité en fonction de la présence
'--- ou non d'une virgule
If Virgule = 0 And Val(N$) > 0 Then
Ajoute "euro"
'--- et on accorde l'unité avec le nombre
If Val(N$) > 1 Then Ajoute "s"
ElseIf Virgule = 1 And Val(N$) > 0 Then
Ajoute "centime"
'--- en ajoutant un "s" si nécessaire
If Val(N$) > 1 Then Ajoute "s"
End If
N$ = ""
Select Case K$
Case Chr$(13)
B = B + 1
Case Is < " "
Case ",", "."
Virgule = 1
'--- si une valeur en euros est exprimée, et que le
'--- nombre de centimes est suffisant pour être traité,
'--- on lie les 2 par le mot "et"
If Val(a$) <> 0 And _
Val("0." + Mid$(a$, B + 1)) >= 0.01 Then Ajoute "et"
Case Else
End Select
End Select
Next
Nb2Mot$ = Résultat$
 
End Function
 
Sub TraduireEntier(NombreATraduire$)
'--- convertit un nombre entier contenu dans une chaine de caractères
'--- en son équivalent ordinal
nombre$ = NombreATraduire$
If nombre$ <> "" Then
'--- si le nombre est 0, on ne perd pas de temps
If Val(nombre$) = 0 Then
Ajoute "zéro"
Else
'--- sinon, on convertit celui-ci en une chaine de caractères
'--- de longueur multiple de 3, afin de pouvoir la lire par blocs
'--- de 3 caractères
nombre$ = Right$("000", -((Len(nombre$) Mod 3) <> 0) * (3 - (Len(nombre$) Mod 3))) _
         + nombre$
For longueur = Len(nombre$) To 3 Step -3
cdu$ = Left$(nombre$, 3)
nombre$ = Right$(nombre$, longueur - 3)
'--- on extrait ainsi des ensembles de 3 chiffres, de la
'--- gauche vers la droite
If cdu$ <> "000" Then
'--- dont on tire une valeur de centaines, dizaines et
'--- unités
C$ = Left$(cdu$, 1)
D$ = Mid$(cdu$, 2, 1)
U$ = Right$(cdu$, 1)
'--- on convertit les unités non muettes pour les
'--- centaines
If C$ >= "2" Then Ajoute Equivalent$(Val(C$))
'--- et on traite les 1 muets
If C$ >= "1" Then
Ajoute "cent"
'--- en appliquant les règles d'accords pour les
'--- centaines
If Val(nombre$) = 0 And D$ + U$ = "00" _
And Len(Résultat$) > 4 Then Ajoute "s"
End If
'--- on analyse si le mot ET est nécessaire (21, 31,
'--- 41 ...)
Et = (D$ >= "2") And (U$ = "1")
'--- ainsi que les tirets pour certains couples
'--- dizaines-unités
Tiret = ((D$ >= "2") And (U$ > "1") _
Or (D$ >= "1" And U$ >= "7")) And Not Et
'--- traitement des valeurs 80-99
If D$ >= "8" Then
Ajoute "quatre-vingt"
Et = 0
'--- retenue nécessaire pour 90 à 99
If D$ = "8" Then D$ = "0" _
Else: D$ = "1": Tiret = True
'--- et traitement des unités
If U$ > "0" Then Tiret = True Else Ajoute "s"
'--- sinon on traite les valeurs 70 à 79
ElseIf D$ = "7" Then
Ajoute "soixante"
'--- avec une retenue pour les dizaines
D$ = "1"
If U$ <> "1" Then Tiret = True
End If
'--- valeurs entre 10 et 16
If (D$ = "1") And (U$ <= "6") Then
D$ = "0"
U$ = "1" + U$
End If
'--- sinon, on gère toutes les autres dizaines
If D$ >= "1" Then
'--- gère les tirets pour les dizaines composées
If Tiret And D$ = "1" _
And Val(Right$(cdu$, 2)) > 19 Then
Ajoute "-"
End If
'--- traduction de la dizaine...
Ajoute Equivalent$(Val(D$ + "0"))
'--- en accordant l'exception des vingtaines
If D$ + U$ = "20" And C$ <> "0" Then Ajoute "s"
End If
'--- si le mot Et est nécessaire, on l'ajoute
If Et Then Ajoute "et"
'--- ainsi que le tiret, liant une dizaine et une
'--- unité
If Tiret Then Ajoute "-"
'--- puis on traduit l'unité du nombre
If Val(U$) >= 22 Or ((Val(U$) >= 1 And (Val(cdu$) > 1 Or longueur <> 6))) Then
    Ajoute Equivalent$(Val(U$))
End If
'--- enfin, la pondération du nombre est respectée,
'--- en ajoutant le multiple nécessaire, et en
'--- l'accordant s'il le faut
Select Case longueur
Case 6: Ajoute "mille"
Case 9: Ajoute "million"
If Val(cdu$) > 1 Then Ajoute "s"
Case 12
Ajoute "milliard"
If Val(cdu$) > 1 Then Ajoute "s"
Case Else
End Select
End If
Next
End If
End If
End Sub

enfin, l'implémentation au formulaire :

Code:

1
2
3
4
Private Sub Chiffre_AfterUpdate()
    Call Nb2Mot(Me!chiffre)
    Me.Lettres = Résultat
End Sub

ps : Merci