[WD-2003] problème de sauvegarde

[bachs]

Bonjour,

j'ai un problème sur l'enregistrement de mes fichiers .doc par GPMI un logiciel de gestion de notre base de données pour l'entreprise, (exemple: a chque rajout d'une facture , commande, ou bon de livraison GPMI il génère la facture, la commande ou le bon de livraison et en imprimant le Doc GPMI sauvegarde automatiquement le fichier créés) le problème c'est que GPMI sauvegarde en deux fois le fichier, un exemplaire qui porte le nom Numéro de facture (expl fac_FC20114129) dans le même répertoire où se trouve notre base de données et un autre exemplaire dans un sous répertoire au même endroit que la base et la donc prends juste le numéro de la facture comme nom.
Et je veux bien que GPMI sauvegarde un seul exemplaire de chaque facture, BL ou Commande.
J'ai essayer de modifier le code VBA de GPMI sur la partie sauvegarde mais je n'ai pas réussi à résoudre le problème.
Voici la partie du code VBA qu'il faut modifier je crois et que je n'arrive pas a comprendre.

Code :

1
2
3
4
5
6
7
8
9
((( 'sauvegarge document dans le chemin de la base : nom= fac_<num>.doc 
msg1$ = base & "\fac_" & Trim$(num_fac) 
ActiveDocument.Protect Password:="", NoReset:=False, Type:=2 
ActiveDocument.SaveAs FileName:=msg1$, FileFormat:=wdFormatDocument _ 
, LockComments:=False, Password:="", AddToRecentFiles:=True, _ 
WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ 
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _ 
False ))) 
:roll:

Merci d'avance pour votre aide.
Cordialement.

[carden752]

Bonjour,

Ce code ne semble faire que l'enregistrement de fac_numerofacture dans la base.

une idée en passant :
Est-ce que lors de la génération du document, il n'est pas automatiquement sauvegardé?

[Heureux-oli]

Salut,

Ce code est bien le code qui enregistre la facture

Ce morceau :

Code :

msg1$ = base & "\fac_" & Trim$(num_fac)

Donne le nom de fichier, il nous manque le contenu de la variable base pour savoir où exactement le fichier est gardé.

Les deux lignes de commandes suivantes vont intervenir sur lap rotection et l'enregistrement du document.

[bachs]

Merci pour vous,
Je m'excuse pour ce retard, j'été en arrêt de travail a cause d une grippe....
a propos de la sauvegarde du ficher au moment de la création (dés que le fichier sera généré) je ne crois pas trop, car on a pas de fichier sauvegardé sans lancer l’impression, et le fichier .doc on peut le visualiser qu'au moment de cliquer sur le bouton IMPRIMER sur le logiciel GPMI.
Je ferai des tests de mon coté si je retrouve la réponse et je profite l'occasion pour vous laisser le code en entier.

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
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
Global ls As String
Global symbmon As String
Global formont As String
Global formontpu As String
 
Sub Edition(base, nomlog, num_fac)
On Error Resume Next
ls = Chr$(13) 'ls=ligne suivante
lecture base, num_fac
 
'entête
ActiveDocument.Tables(1).Cell(1, 1).Range.Text = "Vos Ref :       " & Trim$(cce.refcc)
ActiveDocument.Tables(1).Cell(1, 2).Range.Text = "N°" & num_fac
ActiveDocument.Tables(1).Cell(1, 3).Range.Text = "du " & cfe.dc
 
ActiveDocument.Tables(2).Cell(1, 3).Range.Text = adresse(3)
ActiveDocument.Tables(2).Cell(4, 1).Range.Text = adresse(1)
ActiveDocument.Tables(2).Cell(4, 3).Range.Text = adresse(2)
 
bb$ = "Code Client : " & Trim$(cfe.cc3t) & ls & Trim$(cdr.l)
mnt.mention = cfe.mention1: db_rech "s", "men", codret, 1: If codret <> 0 Then mnt.Libellé = ""
If cfe.cfment1 <> "N" Then bb$ = bb$ & ls & Trim$(mnt.Libellé)
mnt.mention = cfe.mention2: db_rech "s", "men", codret, 1: If codret <> 0 Then mnt.Libellé = ""
If cfe.cfment2 <> "N" Then bb$ = bb$ & ls & Trim$(mnt.Libellé)
If Trim$(cli.tvai) <> "" Then bb$ = bb$ & ls & "TVA Intracommunautaire : " & Trim$(cli.tvai)
ActiveDocument.Tables(2).Cell(1, 1).Range.Text = bb$ & ls & "MODE D'EXPEDITION : " & Trim$(cce.mex)
 
'lecture des lignes
cfl.nf = cfe.nf: cfl.nlf = "": ligne = 0: tot1 = 0: totc1 = 0
db_rech "s", "cfl", codret, 1
Do While codret <> 1
    If cfl.nf = cfe.nf Then
        'recherche unité de conditionnement
        uco.c = cfl.uc: db_rech "s", "uco", codret, 1: If Trim$(uco.l) = "" Then uco.l = cfl.uc
        'nouvelle ligne
        If ligne <> 0 Then
            ActiveDocument.Tables(3).Cell(ligne + 1, 6).Select
            Selection.MoveRight Unit:=12
        End If
 
        'colonne 1 : code article et réf code client
        cpc.cc = cce.cc1t: cpc.ca = cfl.cp: db_rech "s", "cpc", codret, 1: 'If codret <> 0 Then cpc.ac = ""
        bb$ = Trim$(cfl.cp)
        If Trim$(cpc.ac) <> "" Then bb$ = bb$ & ls & "" & Trim$(cpc.ac)
       ' If Trim$(cfl.rcp) <> "" Then bb$ = bb$ & ls & "Réf Cde Client " & Trim$(cfl.rcp)
        bb$ = bb$ & ls & "BL : " & Trim$(cfl.nb) '& " Ligne " & Trim$(cfl.nlb)
        ActiveDocument.Tables(3).Cell(ligne + 2, 1).Range.Text = bb$
 
        'colonne 2 : désignation
        bb$ = Trim$(cfl.d1)
        If Trim$(cfl.d2) <> "" Then bb$ = bb$ & ls & Trim$(cfl.d2)
        If Val(cfl.qg) <> 0 Then bb$ = bb$ & ls & "Dont Gratuit"
        If Val(cfl.mr) <> 0 Then bb$ = bb$ & ls & Trim$(cfl.lr)
        If Val(cfl.mr1) <> 0 Then bb$ = bb$ & ls & Trim$(cfl.lr1)
        If Val(cfl.mr2) <> 0 Then bb$ = bb$ & ls & Trim$(cfl.lr2)
        If Val(cfl.mr3) <> 0 Then bb$ = bb$ & ls & Trim$(cfl.lr3)
        If Val(cfl.ms) <> 0 Then bb$ = bb$ & ls & Trim$(cfl.ls)
        If Val(cfl.mc) <> 0 Then bb$ = bb$ & ls & "Consigne " & Format$(Val(cfl.q))
        If Val(cfl.rfc) <> 0 Then bb$ = bb$ & ls & "Nb Colis " & Format$(Val(cfl.rfc)) & " " & Trim$(uco.l)
        ActiveDocument.Tables(3).Cell(ligne + 2, 2).Range.Text = bb$
 
        'colonne 3 : quantités
        cc$ = Format$(Val(cfl.q)) & " " & Trim$(cfl.uca)
        If Trim$(cfl.d2) <> "" Then cc$ = cc$ + ls
        If Val(cfl.qg) <> 0 Then cc$ = cc$ & ls & Format$(Val(cfl.qg)) & " " & Trim$(cfl.uca)
        If Val(cfl.mr) <> 0 Then cc$ = cc$ + ls
        If Val(cfl.mr1) <> 0 Then cc$ = cc$ + ls
        If Val(cfl.mr2) <> 0 Then cc$ = cc$ + ls
        If Val(cfl.mr2) <> 0 Then cc$ = cc$ + ls
        If Val(cfl.ms) <> 0 Then cc$ = cc$ + ls
        If Val(cfl.mc) <> 0 Then cc$ = cc$ + ls
        ActiveDocument.Tables(3).Cell(ligne + 2, 3).Range.Text = cc$
 
        'colonne 4 : prix unitaire et remises
        dd$ = Format$(Val(cfl.pu), formont)
        If Trim$(cfl.d2) <> "" Then dd$ = dd$ + ls
        If Val(cfl.qg) <> 0 Then dd$ = dd$ + ls
        If Val(cfl.mr) <> 0 Then dd$ = dd$ & ls & Format$(Val(cfl.mr), "-0.00")
        If Val(cfl.mr1) <> 0 Then dd$ = dd$ & ls & Format$(Val(cfl.mr1), "-0.00")
        If Val(cfl.mr2) <> 0 Then dd$ = dd$ & ls & Format$(Val(cfl.mr2), "-0.00")
        If Val(cfl.mr3) <> 0 Then dd$ = dd$ & ls & Format$(Val(cfl.mr3), "-0.00")
        If Val(cfl.ms) <> 0 Then dd$ = dd$ & ls & Format$(Val(cfl.ms), formont)
        If Val(cfl.mc) <> 0 Then dd$ = dd$ & ls & Format$(Val(cfl.mc), formont)
        ActiveDocument.Tables(3).Cell(ligne + 2, 4).Range.Text = dd$
 
        'colonne 5 : prix total ligne
        dd$ = Format$((Val(cfl.pu) * (Val(cfl.q) - Val(cfl.qg))) - Val(cfl.mr) - Val(cfl.mr1) - Val(cfl.mr2) - Val(cfl.mr3) + Val(cfl.ms), formont)
        tot1 = tot1 + Val(dd$)
        If Trim$(cfl.d2) <> "" Then dd$ = dd$ + ls
        If Val(cfl.qg) <> 0 Then dd$ = dd$ + ls
        If Val(cfl.mr) <> 0 Then dd$ = dd$ + ls
        If Val(cfl.mr1) <> 0 Then dd$ = dd$ + ls
        If Val(cfl.mr2) <> 0 Then dd$ = dd$ + ls
        If Val(cfl.mr3) <> 0 Then dd$ = dd$ + ls
        If Val(cfl.ms) <> 0 Then dd$ = dd$ + ls
        If Val(cfl.mc) <> 0 Then dd$ = dd$ & ls & Format$(Val(cfl.mc) * Val(cfl.q), formont)
        ActiveDocument.Tables(3).Cell(ligne + 2, 5).Range.Text = Round(dd$, 2)
 
        'colonne 6 : code tva
        ActiveDocument.Tables(3).Cell(ligne + 2, 6).Range.Text = cfl.ct
        totc1 = totc1 + (Val(cfl.mc) * Val(cfl.q))
 
        'lecture ligne suivante
        ligne = ligne + 1
        db_rech "n", "cfl", codret, 1
        Else
        codret = 1
    End If
Loop
 
'table Total et Transport
ActiveDocument.Tables(4).Cell(2, 2).Range.Text = Round(Format$(tot1, formont), 2)
sep$ = "": dd$ = ""
If Val(cfe.mttranspf) <> 0 Then dd$ = dd$ + sep$ + Trim$(cfe.transp): sep$ = ls
If Val(cfe.mttransitf) <> 0 Then dd$ = dd$ + sep$ + Trim$(cfe.transit): sep$ = ls
If Val(cfe.mtassf) <> 0 Then dd$ = dd$ + sep$ + Trim$(cfe.assurance): sep$ = ls
ActiveDocument.Tables(4).Cell(4, 2).Range.Text = dd$
 
sep$ = "": dd$ = ""
If Val(cfe.mttranspf) <> 0 Then dd$ = dd$ + sep$ + Format$(Val(cfe.mttranspf), formont): sep$ = ls
If Val(cfe.mttransitf) <> 0 Then dd$ = dd$ + sep$ + Format$(Val(cfe.mttransitf), formont): sep$ = ls
If Val(cfe.mtassf) <> 0 Then dd$ = dd$ + sep$ + Format$(Val(cfe.mtassf), formont): sep$ = ls
ActiveDocument.Tables(4).Cell(4, 3).Range.Text = Round(dd$, 2)
 
ActiveDocument.Tables(4).Cell(4, 4).Range.Text = cfe.ct
 
'table TVA et montants totaux
ActiveDocument.Tables(5).Cell(2, 1).Range.Text = cfe.ct1
ActiveDocument.Tables(5).Cell(2, 2).Range.Text = Round(Format$(Val(cfe.tt1), formont), 2)
ActiveDocument.Tables(5).Cell(2, 3).Range.Text = Round(Format$(Val(cfe.mht1), formont), 2)
ActiveDocument.Tables(5).Cell(2, 4).Range.Text = Round(Format$(Val(cfe.mtt1) - Val(cfe.mht1), formont), 2)
ActiveDocument.Tables(5).Cell(2, 5).Range.Text = Round(Format$(Val(cfe.mtt1), formont), 2)
ActiveDocument.Tables(5).Cell(3, 1).Range.Text = cfe.ct2
ActiveDocument.Tables(5).Cell(3, 2).Range.Text = Format$(Val(cfe.tt2), formont)
ActiveDocument.Tables(5).Cell(3, 3).Range.Text = Format$(Val(cfe.mht2), formont)
ActiveDocument.Tables(5).Cell(3, 4).Range.Text = Format$(Val(cfe.mtt2) - Val(cfe.mht2), formont)
ActiveDocument.Tables(5).Cell(3, 5).Range.Text = Format$(Val(cfe.mtt2), formont)
ActiveDocument.Tables(5).Cell(4, 1).Range.Text = cfe.ct3
ActiveDocument.Tables(5).Cell(4, 2).Range.Text = Format$(Val(cfe.tt3), formont)
ActiveDocument.Tables(5).Cell(4, 3).Range.Text = Format$(Val(cfe.mht3), formont)
ActiveDocument.Tables(5).Cell(4, 4).Range.Text = Format$(Val(cfe.mtt3) - Val(cfe.mht3), formont)
ActiveDocument.Tables(5).Cell(4, 5).Range.Text = Format$(Val(cfe.mtt3), formont)
ActiveDocument.Tables(5).Cell(5, 1).Range.Text = cfe.ct4
ActiveDocument.Tables(5).Cell(5, 2).Range.Text = Format$(Val(cfe.tt4), formont)
ActiveDocument.Tables(5).Cell(5, 3).Range.Text = Format$(Val(cfe.mht4), formont)
ActiveDocument.Tables(5).Cell(5, 4).Range.Text = Format$(Val(cfe.mtt4) - Val(cfe.mht4), formont)
ActiveDocument.Tables(5).Cell(5, 5).Range.Text = Format$(Val(cfe.mtt4), formont)
ActiveDocument.Tables(5).Cell(6, 1).Range.Text = cfe.ct5
ActiveDocument.Tables(5).Cell(6, 2).Range.Text = Format$(Val(cfe.tt5), formont)
ActiveDocument.Tables(5).Cell(6, 3).Range.Text = Format$(Val(cfe.mht5), formont)
ActiveDocument.Tables(5).Cell(6, 4).Range.Text = Format$(Val(cfe.mtt5) - Val(cfe.mht5), formont)
ActiveDocument.Tables(5).Cell(6, 5).Range.Text = Format$(Val(cfe.mtt5), formont)
 
dd1$ = Format$(Val(cfe.mht1) + Val(cfe.mht2) + Val(cfe.mht3) + Val(cfe.mht4) + Val(cfe.mht5), formont)
ActiveDocument.Tables(5).Cell(1, 8).Range.Text = Round(dd1$, 2)
dd2$ = Format$(Val(cfe.mtt1) + Val(cfe.mtt2) + Val(cfe.mtt3) + Val(cfe.mtt4) + Val(cfe.mtt5), formont)
ActiveDocument.Tables(5).Cell(3, 8).Range.Text = Round(dd2$, 2)
dd$ = Val(dd2$) - Val(dd1$)
ActiveDocument.Tables(5).Cell(2, 8).Range.Text = Round(Format$(Val(dd$), formont), 2)
mt1 = Val(dd2$)
If Val(cfe.tesc) <> 0 Then
    mt2 = Val(cfe.mttranspf) + Val(cfe.mtassf) + Val(cfe.mttransitf)
    mt2 = mt2 * (1 + (Val(cfe.pt) / 100))
    mt3 = mt1 - mt2
    mt3 = mt3 * Val(cfe.tesc) / 100
    dd$ = "Escompte " & Format$(Val(cfe.tesc)) & "%"
    ActiveDocument.Tables(5).Cell(4, 7).Range.Text = Round(dd$, 2)
    ActiveDocument.Tables(5).Cell(4, 8).Range.Text = Round(Format$(mt3, formont), 2)
    mt1 = mt1 - mt3
End If
ActiveDocument.Tables(5).Cell(5, 8).Range.Text = Round(Round(Format$(mt1, formont), 2), 2)
If totc1 <> 0 Then
    ActiveDocument.Tables(5).Cell(6, 7).Range.Text = "Total Consignes"
    ActiveDocument.Tables(5).Cell(6, 8).Range.Text = Round(Format$(totc1, formont), 2)
    mt1 = mt1 + totc1
End If
ActiveDocument.Tables(5).Cell(7, 8).Range.Text = Round(Format$(mt1, formont), 2)
If Val(cfe.mgr) <> 0 Then
    ActiveDocument.Tables(5).Cell(8, 3).Range.Text = "Acomptes versés"
    ActiveDocument.Tables(5).Cell(8, 4).Range.Text = Round(Format$(Val(cfe.mgr), formont), 2)
    mt1 = mt1 - Val(cfe.mgr)
End If
ActiveDocument.Tables(5).Cell(9, 4).Range.Text = Round(Format$(mt1, formont), 2)
dd$ = "Montants en " & cfe.dv
ActiveDocument.Tables(5).Cell(8, 1).Range.Text = Round(dd$, 2)
dd$ = "Date prochaine échéance : " & cfe.dech
ActiveDocument.Tables(5).Cell(9, 1).Range.Text = Round(dd$, 2)
 
'affichage du mmo de la table client
ActiveDocument.Tables(6).Cell(1, 1).Range.Text = test.mm
 
 
'sauvegarge document dans le chemin de la base : nom= fac_<num>.doc
msg1$ = base & "\fac_" & Trim$(num_fac)
ActiveDocument.Protect Password:="", NoReset:=False, Type:=2
ActiveDocument.SaveAs FileName:=msg1$, FileFormat:=wdFormatDocument _
    , LockComments:=False, Password:="", AddToRecentFiles:=True, _
    WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
     SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
    False
 
End Sub
 
Function getparam(c1$, c2$, v$)
On Error Resume Next
getparam = v$
Dim toto1 As Recordset
mm$ = "select * from installation where code1='" & c1$ & "' and code2='" & c2$ & "'"
Set toto1 = db.OpenRecordset(mm$)
If Not toto1.EOF Then getparam = toto1("Valeur")
toto1.Close
 
End Function
 
Sub lecture(base, num_cde)
Set db = OpenDatabase(base)
base = Left$(base, Len(base) - 10)
ChDrive base
ChDir base
elt.nl = getparam("elt", "nl", "0")
elt.ns = getparam("elt", "ns", "0")
elt.sm = getparam("elt", "sm", "€")
elt.nd = getparam("elt", "nd", "2")
elt.ndpu = getparam("elt", "ndpu", "2")
symbmon = Trim$(elt.sm)
nbdec = Val(elt.nd): formont = "0." + String$(nbdec, "0")
nbdecpu = Val(elt.ndpu): formontpu = "0." + String$(nbdecpu, "0")
 
cfe.nf = num_cde
db_rech "s", "cfe", codret, 1
LSet cce = cfe
 
cdr.c = cce.fcdr
db_rech "s", "cdr", codret, 1
 
cli.cc = cce.cc3t
db_rech "s", "cli", codret, 1
 
End Sub
 
Function adresse(n)
If n = 1 Then
    bb$ = Trim$(cce.n1) & ls & Trim$(cce.i1)
    bb$ = bb$ & ls & Trim$(cce.a11)
    bb$ = bb$ & ls & Trim$(cce.a21)
    bb$ = bb$ & ls & Trim$(cce.cp1) & " " & Trim$(cce.v1) & ls & Trim$(cce.pays1)
End If
If n = 2 Then
    bb$ = Trim$(cce.n2) & ls & Trim$(cce.i2)
    bb$ = bb$ & ls & Trim$(cce.a12)
    bb$ = bb$ & ls & Trim$(cce.a22)
    bb$ = bb$ & ls & Trim$(cce.cp2) & " " & Trim$(cce.v2) & ls & Trim$(cce.pays2)
End If
If n = 3 Then
    bb$ = Trim$(cce.n3) & ls & Trim$(cce.i3)
    bb$ = bb$ & ls & Trim$(cce.a13)
    bb$ = bb$ & ls & Trim$(cce.a23)
    bb$ = bb$ & ls & Trim$(cce.cp3) & " " & Trim$(cce.v3) & ls & Trim$(cce.pays3)
End If
adresse = bb$
 
End Function
 
 
 
 
Sub chc()
On Error Resume Next
 
For i = 1 To ActiveDocument.Tables.Count
For j = 1 To ActiveDocument.Tables(i).Rows.Count
For k = 1 To ActiveDocument.Tables(i).Rows(j).Cells.Count
'Stop
ActiveDocument.Tables(i).Cell(j, k).Select
'If ActiveDocument.Tables(i).Cell(j, k).Shading.BackgroundPatternColor =wdColorSeagreen then
If ActiveDocument.Tables(i).Cell(j, k).Shading.BackgroundPatternColor <> -16777216 Then
ActiveDocument.Tables(i).Cell(j, k).Shading.BackgroundPatternColor = RGB(230, 237, 248)
ActiveDocument.Tables(i).Cell(j, k).Shading.ForegroundPatternColor = RGB(230, 237, 248)
ActiveDocument.Tables(i).Cell(j, k).Select
Selection.Font.Color = wdColorIndigo
End If
Next k
Next j
Next i
 
End Sub

MERCI d'avance pour vous.
Cordialement

[bachs]

Bonjour,

J’ai essayé de modifier le chemin d’emplacement des fichiers enregistrés, pour cela j’ai juste remplacé sur cette ligne (ligne 194 sur le code au dessus de l’autre message)

Code :

msg1$ = base & "\fac_" & Trim$(num_fac)

par :

Code :

 msg1$ = "C:\Users\BACHS\Desktop\Teste\....\.....\" & Trim$(num_fac)

Mais l’enregistrement est toujours en double, a chaque fois GPMI crée un répertoire nommé « rapports word » dans le quel il recrée des répertoires « Factures, BL, CdeCli, CdeAchats ) donc a la fin on retrouve les fichiers générés et /ou créés dans les deux répertoires a chaque fois (dans « rapport word » tous mélangés ( les factures , les BL et les Commandes) et dans les sous répertoires « factures » , « BL » et « Commandes »)
Donc ma question est toujours pourquoi on la sauvegarde est toujours en double pour chaque fichiers généré ??
Cordialement.