Pb fonction transformation chiffres en lettres

**fbu78** · 29/07/2009, 11h48

Bonjour,

J'emploie dans une application la fonction suivante pour transformer des chiffres en lettres (génération de lettre-chèques). Or il se trouve qu'il y a quelques erreurs d'accords dans l'écriture en lettres, notamment :
Cent :
Quatre cents avec S mais Quatre cent dix sans S Deux cent mille sans S à cent ni à mille
Vingt :
Quatre-vingts avec S Quatre-vingt deux ou Quatre-vingt dix sans S Quatre cent quatre-vingt mille : pas de S nulle part

Malgré quelques heures de recherches je ne parviens pas à corriger la fonction.
Si quelqu'un à une idée de l'endroit où il faut corriger, ça serait avec plaisir !

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
Option Compare Database
Option Explicit
 
Dim mot$(25), Resultat$, N$
Dim Virgule, B, K$, nombre$, longueur
Dim cdu$, C$, D$, U$, Et, Tiret
 
 
Sub Ajoute(MotSimple$)
'--- ajoute un nouveau terme traduit à la chaine résultat
    If Resultat$ <> "" 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$(Resultat$, 1) = "-" Or _
           MotSimple$ = "s" Or MotSimple$ = "-" Then
            Resultat$ = Resultat$ + MotSimple$
            '--- sinon, ajoute le terme après un espace
        Else
            Resultat$ = Resultat$ + " " + MotSimple$
        End If
    Else
        Resultat$ = 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
    Resultat$ = ""
    '--- 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$ = Resultat$
 
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(Resultat$) > 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

ans un formulaire avec un champ [MontantC], l'appel de la fonction se fait dans un autre champ avec MontantL=Nb2Mot([MontantC])

Merci d'avance.

**Jean-Philippe André** · 29/07/2009, 12h01

salut,
sauf erreur de ma part,
tu peux juste vérifier que le dernier mot qui sort de ta transformation est cent ou vingt, auquel cas tu vérifies le mot "juste avant" et tu ajoutes un s en fonction de ce que tu récupères, non ?

**fbu78** · 29/07/2009, 13h00

euh...je ne vois pas bien comment faire ça...

Un petit coup de main serait le bienvenu, si c'est possible

Merci d'avance

Fred

**Jean-Philippe André** · 29/07/2009, 14h41

en partant du principe que tu arriveras à une méthode du style :

Code :

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

MontantL=Nb2Mot([MontantC])

je te propose un

Code :

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

1
2
3
4
5
6
7
8
9
Function Nb2Mot2(strinput as string) as string
if right(strinput,4) = "cent"
'on s'assure que le nombre précédent le cent est bien compris entre 2 et 9
end if
if right(strinput,12) = "quatre-vingt"
Nb2Mot2 = strinput & "s"
end if
 
End Function

qui deviendra donc

Code :

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

MontantL=Nb2mot2(Nb2Mot([MontantC]))

**fbu78** · 29/07/2009, 15h19

Merci pour cette réponse rapide... je ne comprends pas le code, et je ne vois pas comment m'en servir précisement.

Est-ce qu'il serait possible de compléter ton explication ?

Re merci d'avance

Fred

**Jean-Philippe André** · 29/07/2009, 15h25

je te propose une nouvelle fonction qui prend en entrée la sortie de la fonction qui transforme les nombres en lettres.

on va regarder les dernieres lettres de la chaine de caractères passée en paramètre (fonction right())

et en fonction de cela, on ajoute ou non un s à la fin de la chaine

**fbu78** · 29/07/2009, 16h21

je vais essayer ça ce soir

Merci.

Pb fonction transformation chiffres en lettres

VBA Access

Discussions similaires

Partager

Partager