ConvNumberLetter Word - convertir nombres en lettres

**Le_Masque_De_Zoro** · 15/07/2014, 15h42

Bonjour,

Je cherche à automatiser la conversion de nombres en lettres sur word. Je souhaite volontairement ne pas devoir recourir à excel. Pour le moment, aucune des solutions que j'ai trouvées ne sont satisfaisantes.

Ce que je souhaite faire :

Avoir un champ texte { } dans lequel j'indiquerai un nombre, et que je référencerai en temps que bookmark (disons "SIGNET"), et qui serait lié avec un autre champ qui le convertirait automatiquement en lettres.

1/ Utilisation d'un champ et de \* Cardtext. Cela correspond à mon usage dans la mesure où j'arrive à lier le bookmark au champ cardtext ( { = SIGNET \* Cardtext} ). Malheureusement les restrictions inhérentes à Cardtext rende cette procédure inutile pour mon usage (mes nombres sont régulièrement > 999.999)

2/ J'ai trouvé la macro "BigCardText" qui gère les nombres > 999.999.

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
Sub BigCardText()
    Dim sDigits As String
    Dim sBigStuff As String
 
    sBigStuff = ""
 
    ' Select the full number in which the insertion point is located
    Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdMove
    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
 
    ' Store the digits in a variable
    sDigits = Trim(Selection.Text)
 
    If Val(sDigits) > 999999 Then
        If Val(sDigits) <= 999999999 Then
            sBigStuff = Trim(Int(Str(Val(sDigits) \ 1000000)))
            ' Create a field containing the big digits and the cardtext format flag
            Selection.Fields.Add Range:=Selection.Range, _
              Type:=wdFieldEmpty, Text:="= " + sBigStuff + " \* CardText", _
              PreserveFormatting:=True
 
            ' Select the field and copy it
            Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
            sBigStuff = Selection.Text & " million "
            sDigits = Right(sDigits, 6)
        End If
    End If
    If Val(sDigits) <= 999999 Then
        ' Create a field containing the digits and the cardtext format flag
        Selection.Fields.Add Range:=Selection.Range, _
          Type:=wdFieldEmpty, Text:="= " + sDigits + " \* CardText", _
          PreserveFormatting:=True
 
        ' Select the field and copy it
        Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
        sDigits = sBigStuff & Selection.Text
 
        ' Now put the words in the document
        Selection.TypeText Text:=sDigits
        Selection.TypeText Text:=" "
    Else
        MsgBox "Number too large", vbOKOnly
    End If
End Sub

Intéressant, mais deux obstacles :

- je ne sais pas comment "lier" l'exécution de cette macro à un signet dans mon document, comme au 1/ ci-dessus. Je ne peux que positionner le pointeur sur un nombre, puis exécuter la macro. Cela remplace le nombre écrit en chiffre par le nombre en toutes lettres. Je cherche à ce que cela se fasse automatiquement, et se mette à jour le cas échéant si je change le chiffre.
- cela ne gère pas les décimales, dont je peux avoir besoin.

3/ J'utilise sous excel la fonction ConvNumberLetter (que j'ai légèrement modifiée) :

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
Option Explicit
 
 
'***********
' Devise=0   aucune
'       =1   Euro €
'       =2   Dollar $
' 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 arrondi à 2 décimales
 
 
Public Function ConvNumTestFr(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
            ConvNumTestFr = "#TropGrand"
            Exit Function
        End If
    Else
        If dblEnt > 9999999999999.99 Then
            ConvNumTestFr = "#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 & " centime"
            If byDec > 1 Then strCentimes = strCentimes & "s"
        Case 2
            strDev = " dollar"
            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
        ConvNumTestFr = "zéro " & strDev
    Else
        ConvNumTestFr = ConvNumEnt(CDbl(dblEnt), Langue) & strDev
    End If
 
    If byDec = 0 Then
        If Devise <> 0 Then ConvNumTestFr = ConvNumTestFr & ""
    Else
        If Devise = 0 Then
            ConvNumTestFr = ConvNumTestFr & _
                ConvNumDizaine(byDec, Langue, True) & strCentimes
        Else
            ConvNumTestFr = ConvNumTestFr & _
                ConvNumDizaine(byDec, Langue, False) & strCentimes
        End If
    End If
 
    ConvNumTestFr = Replace(ConvNumTestFr, "  ", " ")
    If Left(ConvNumTestFr, 1) = " " Then ConvNumTestFr = _
        Right$(ConvNumTestFr, Len(ConvNumTestFr) - 1)
    If Right$(ConvNumTestFr, 1) = " " Then ConvNumTestFr = _
        Left(ConvNumTestFr, Len(ConvNumTestFr) - 1)
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
Sub Conversion()
 
End Sub

Cette fonction me permet, sous excel, d'obtenir de manière satisfaisante n'importe quel nombre écrit en toutes lettres. Or, j'ai trouvé un post (que je ne retrouve plus...) où un utilisateur l'utilisait sous word, sans recours à excel. Seulement, cette fonction s'activait via un formulaire qui se lançait lors du lancement du document modèle ; le formulaire invitait l'utilisateur à entrer un nombre écrit en chiffres ; la fonction convertissait alors ce nombre dans le document word.

L'idéal pour moi serait de pouvoir lancer cette fonction via un champ (j'imagine) de manière à convertir automatiquement un nombre référencé (via idéalement un champ texte). J'ignore comment faire cela.

Merci beaucoup par avance.

P.

**Sepia** · 17/07/2014, 01h18

Salut Le_Masque_De_Zoro,

ll est possible de lier un champ de formulaire à un macro (en début ou en fin) et de l'associer à un signet mais pas un signet seul. Créer un champ de formulaire (type zone de saisie) et regarde les paramètres, tu trouveras les 2 zones pour définir une macro à exécuter en début ou en fin.

@+

ConvNumberLetter Word - convertir nombres en lettres

VBA Word

Discussions similaires

Partager

Partager