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
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
| Private Sub bPretAjouterItem_Click()
'"I'm too hardcore to kill softly..." No need of these warning signs
DoCmd.SetWarnings False
'Declaration generique de la connection a la base de donnees courante
Dim cnn As ADODB.Connection
'Declaration du recordset qui va contenir l'ancienne nomenclature/description
Dim rstGroupeItem As New ADODB.Recordset
Dim rstItem As New ADODB.Recordset
Dim rstPret As New ADODB.Recordset
'TEST: declaration des 'capscules' sur les controles
Dim ctl_gShowInventaire As New Control
Dim ctl_lItem As New Control
Dim ctl_tPretQte As New Control
Dim ctl_lPret As New Control
Dim ctl_tNoClient As New Control
'Declaration de la variable qui sera assigne la valeur du CodeMat de l'object presentement selectionne / OU / GroupeID du groupe selectionne!!
Dim pubCodeMat As String
Dim pubGroupeID As Integer
Dim iPretQte As Integer
Dim args As String
Dim okGroupe As Boolean
Dim itm As Variant
Dim QteSelected As Integer
Dim strSource As String
'TEST: assignation des controles sur la form vers la capsule
Set ctl_gShowInventaire = Me!gShowInventaire
Set ctl_lItem = Me!lItem
Set ctl_tPretQte = Me!tPretQte
Set ctl_lPret = Me!lPret
Set ctl_tNoClient = Me!tNoClient
okGroupe = False
'AJOUTER LA VERIFICATION DE L'AUTHENTICITE DE LA VALEUR DE tPretQte!!!!!!!!!!!!!!!! ************************
'Vérification de l'authenticité de la valeur inscrite dans tPretQte! (null, négative ou alpha-numérique)
If IsNull(ctl_tPretQte) Or Not IsNumeric(ctl_tPretQte) Or (ctl_tPretQte.Value <= 0) Then
MsgBox "Ne peut contenir de valeur nulle, négative, ou alpha-numérique.", 16, "Erreur"
'Mise-a-jour de lGroupeItem, reset de tPretQte.Value et deselection de lItem
ctl_tPretQte = Null
ctl_lItem = Null
ctl_lItem.Requery
ctl_lPret = Null
GoTo Exit_bPretAjouterItem_Click
End If
iPretQte = ctl_tPretQte.Value
'petite loop pour vérifier qu'un au moins item a été sélectionné
For Each itm In ctl_lItem.ItemsSelected
QteSelected = QteSelected + 1
Next itm
itm = Null
'Vérification si il y a un NoClient d'inscrit dans le champs approprié.
'(à savoir si c'est pas un new pret... sans destinataire!
If Not IsNull(ctl_tNoClient) Then
'Verification si un item/groupe a ete selectionner.
If (QteSelected > 0) Then
'Un item/groupe a ete selectionner, keep going!
'Assignation de la base de donne courante a une connection ADO
Set cnn = CurrentProject.Connection
'Doit maintenant determiner s'agit d'un groupe ou d'un item! en verifiant l'etat de gShowInventaire
If (ctl_gShowInventaire = 1) Then
'AFFICHE PRESENTEMENT DES ITEMS -> DONC UN ITEM EST SELECTIONNE!
'Assignation du pubCodeMat de l'item presentement selectionne
For Each itm In ctl_lItem.ItemsSelected
pubCodeMat = ctl_lItem.ItemData(itm)
'PASS POUR LES NO-SERIES! _si_ l'item a des numero de serie!!
rstItem.Open "SELECT tblItem.AvecNoSerie FROM tblItem WHERE (tblItem.CodeMat = '" & pubCodeMat & "')", cnn, adOpenStatic
If (rstItem!AvecNoSerie) Then
'Ouverture de la fenetre de NoSerie action:codemat:qte:noclient
args = "pret;" & pubCodeMat & ";" & iPretQte & ";" & pubNoClient
DoCmd.OpenForm "FrmPretNoSerie", , , , , acDialog, args
Else
Me!rNoSerieCheck = 1
End If
rstItem.Close
'Verification que les numeros de series sont passe vers le pret!
If (Me!rNoSerieCheck) Then
Me!rNoSerieCheck = Null
'Ouverture de la connection ADO sur la base de donnees courante sur le recordset defini
rstItem.Open "SELECT tblItem.* FROM tblItem WHERE (tblItem.CodeMat = '" & pubCodeMat & "')", cnn, adOpenStatic
rstItem.MoveFirst
rstPret.Open "SELECT tblPret.NoClient, tblPret.CodeMat, tblPret.Qte FROM tblPret WHERE (tblPret.NoClient = '" & pubNoClient & "')", cnn, adOpenStatic
'Validation si le client courant a des prets
If (rstPret.RecordCount > 0) Then
'lPret/rstPret/tblPret (relier au pubNoClient) n'est pas vide!
rstPret.Find "[CodeMat] = '" & pubCodeMat & "'"
'Vérification si le CodeMat sélectionné a été trouvé dans les prets. pour insert/update
If Not (rstPret.EOF) And Not (rstPret.BOF) Then
'PRET NON-VIDE ::: READY POUR UPDATE!!!!
'Vérification des Quantités disponible dans tblItem!
If (iPretQte <= rstItem!QteBalance) Then
DoCmd.RunSQL "UPDATE tblPret SET tblPret.Qte = " & iPretQte + rstPret!QTE & " WHERE ((tblPret.CodeMat = '" & pubCodeMat & "') AND (tblPret.NoClient = '" & pubNoClient & "'))"
DoCmd.RunSQL "UPDATE tblItem SET tblItem.QteBalance = " & rstItem!QteBalance - iPretQte & " WHERE (tblItem.CodeMat = '" & pubCodeMat & "')"
'DoCmd.RunSQL "UPDATE tblItem SET tblItem.QteEnPret = " & rstItem!QteEnPret + iPretQte & " WHERE (tblItem.CodeMat = '" & pubCodeMat & "')"
DoCmd.RunSQL "UPDATE tblPret SET tblPret.modDate = #" & Format(Date, "yyyy/mm/dd") & "# WHERE ((tblPret.CodeMat = '" & pubCodeMat & "') AND (tblPret.NoClient = '" & pubNoClient & "'))"
DoCmd.RunSQL "UPDATE tblPret SET tblPret.modTime = #" & Format(Time, "h:mm:s") & "# WHERE ((tblPret.CodeMat = '" & pubCodeMat & "') AND (tblPret.NoClient = '" & pubNoClient & "'))"
Else
MsgBox "Impossible de réserver plus d'item que la quantité disponible dans l'inventaire.", 16, "Erreur"
End If
Else
'PRET NON-VIDE ::: READY POUR INSERT!!!!
'Vérification des Quantités disponible dans tblItem!
If (iPretQte <= rstItem!QteBalance) Then
'DoCmd.RunSQL "UPDATE tblPret SET tblPret.Qte = " & iPretQte + rstPret!Qte & " WHERE ((tblPret.CodeMat = '" & pubCodeMat & "') AND (tblPret.NoClient = '" & pubNoClient & "'))"
DoCmd.RunSQL "INSERT INTO tblPret (CodeMat, NoClient, Qte) VALUES ('" & pubCodeMat & "', '" & pubNoClient & "', " & iPretQte & ")"
DoCmd.RunSQL "UPDATE tblItem SET tblItem.QteBalance = " & rstItem!QteBalance - iPretQte & " WHERE (tblItem.CodeMat = '" & pubCodeMat & "')"
'DoCmd.RunSQL "UPDATE tblItem SET tblItem.QteEnPret = " & rstItem!QteEnPret + iPretQte & " WHERE (tblItem.CodeMat = '" & pubCodeMat & "')"
DoCmd.RunSQL "UPDATE tblPret SET tblPret.modDate = #" & Format(Date, "mm/dd/yyyy") & "# WHERE ((tblPret.CodeMat = '" & pubCodeMat & "') AND (tblPret.NoClient = '" & pubNoClient & "'))"
DoCmd.RunSQL "UPDATE tblPret SET tblPret.modTime = #" & Format(Time, "h:mm:s") & "# WHERE ((tblPret.CodeMat = '" & pubCodeMat & "') AND (tblPret.NoClient = '" & pubNoClient & "'))"
Else
MsgBox "Impossible de réserver plus d'item que la quantité disponible dans l'inventaire.", 16, "Erreur"
End If
End If
Else
'lPret/rstPret/tblPret (lier au pubNoClient) est vide. PRET VIERGE!!!! READY FOR INSERT!
'PRET VIDE ::: READY POUR INSERT!!!! (vierge)
'Vérification des Quantités disponible dans tblItem!
If (iPretQte <= rstItem!QteBalance) Then
'DoCmd.RunSQL "UPDATE tblPret SET tblPret.Qte = " & iPretQte + rstPret!Qte & " WHERE ((tblPret.CodeMat = '" & pubCodeMat & "') AND (tblPret.NoClient = '" & pubNoClient & "'))"
DoCmd.RunSQL "INSERT INTO tblPret (CodeMat, NoClient, Qte) VALUES ('" & pubCodeMat & "', '" & pubNoClient & "', " & iPretQte & ")"
DoCmd.RunSQL "UPDATE tblItem SET tblItem.QteBalance = " & rstItem!QteBalance - iPretQte & " WHERE (tblItem.CodeMat = '" & pubCodeMat & "')"
'DoCmd.RunSQL "UPDATE tblItem SET tblItem.QteEnPret = " & rstItem!QteEnPret + iPretQte & " WHERE (tblItem.CodeMat = '" & pubCodeMat & "')"
DoCmd.RunSQL "UPDATE tblPret SET tblPret.modDate = #" & Format(Date, "mm/dd/yyyy") & "# WHERE ((tblPret.CodeMat = '" & pubCodeMat & "') AND (tblPret.NoClient = '" & pubNoClient & "'))"
DoCmd.RunSQL "UPDATE tblPret SET tblPret.modTime = #" & Format(Time, "h:mm:s") & "# WHERE ((tblPret.CodeMat = '" & pubCodeMat & "') AND (tblPret.NoClient = '" & pubNoClient & "'))"
Else
MsgBox "Impossible de réserver plus d'item que la quantité disponible dans l'inventaire.", 16, "Erreur"
End If
End If
rstPret.Close
rstItem.Close
End If
Next itm
Else
'AFFICHE PRESENTEMENT DES GROUPES -> DONC UN GROUPE EST SELECTIONNE!
'Plusieurs verifications a venir. pour les quantites avec les groupes!
'Assignation du pubGroupeId du groupe presentement selectionne
For Each itm In ctl_lItem.ItemsSelected
pubGroupeID = ctl_lItem.ItemData(itm)
'Recordset qui se trouve a pointé vers les items du groupe sélectionné!
rstGroupeItem.Open "SELECT tblGroupeItem.* FROM tblGroupeItem WHERE (tblGroupeItem.GroupeID = " & pubGroupeID & ")", cnn, adOpenStatic
'Vérification à savoir si le groupe contient ou non des Items!
'If Not (rstGroupeItem.BOF) And Not (rstGroupeItem.EOF) Then
If (rstGroupeItem.RecordCount > 0) Then
rstGroupeItem.MoveFirst
'Loop de vérification d'intégrité du groupe (si le groupe apte au pret)
Do Until rstGroupeItem.EOF
pubCodeMat = rstGroupeItem!CodeMat
'Ouverture de la connection ADO sur la base de donnees courante sur le recordset defini
rstItem.Open "SELECT tblItem.* FROM tblItem WHERE (tblItem.CodeMat = '" & pubCodeMat & "')", cnn, adOpenStatic
rstItem.MoveFirst
rstPret.Open "SELECT tblPret.NoClient, tblPret.CodeMat, tblPret.Qte FROM tblPret WHERE (tblPret.NoClient = '" & pubNoClient & "')", cnn, adOpenStatic
'Validation si le client courant a des prets
If (rstPret.RecordCount > 0) Then
'lPret/rstPret/tblPret (relier au pubNoClient) n'est pas vide!
rstPret.MoveFirst
rstPret.Find "[CodeMat] = '" & pubCodeMat & "'"
'Vérification si le CodeMat sélectionné a été trouvé dans les prets. pour insert/update
If Not (rstPret.EOF) And Not (rstPret.BOF) Then
'PRET NON-VIDE ::: READY POUR UPDATE!!!!
If ((iPretQte * rstGroupeItem!QTE) <= rstItem!QteBalance) Then
okGroupe = True
Else
MsgBox "Une erreur est survenu, impossible de réserver ce groupe." & Chr(13) & "L'item (" & rstGroupeItem!Nomenclature & ") est en défaut. Vérifier les quantités dans la gestion des groupes.", 16, "Erreur"
rstItem.Close
rstPret.Close
GoTo OutOfLoop
End If
Else
'PRET NON-VIDE ::: READY POUR INSERT!!!!
If ((iPretQte * rstGroupeItem!QTE) <= rstItem!QteBalance) Then
okGroupe = True
Else
MsgBox "Une erreur est survenu, impossible de réserver ce groupe." & Chr(13) & "L'item (" & rstGroupeItem!Nomenclature & ") est en défaut. Vérifier les quantités dans la gestion des groupes.", 16, "Erreur"
rstItem.Close
rstPret.Close
GoTo OutOfLoop
End If
End If
Else
'PRET VIDE ::: READY POUR INSERT!!!! (vierge)
If ((iPretQte * rstGroupeItem!QTE) <= rstItem!QteBalance) Then
okGroupe = True
Else
MsgBox "Une erreur est survenu, impossible de prêter ce groupe." & Chr(13) & "L'item (" & rstGroupeItem!Nomenclature & ") est en défaut. Vérifier les quantités dans la gestion des groupes.", 16, "Erreur"
rstItem.Close
rstPret.Close
GoTo OutOfLoop
End If
End If
rstPret.Close
rstItem.Close
rstGroupeItem.MoveNext
Loop
'rewind au début du rstGroupeItem
rstGroupeItem.MoveFirst
'Loop qui "visite" chaque item dans le groupe pour les ajouter au pret, un à un.
'SI LE GROUPE EST OK pour ETRE AJOUTER!
If (okGroupe) Then
Do Until rstGroupeItem.EOF
pubCodeMat = rstGroupeItem!CodeMat
'PASS POUR LES NO-SERIES! _si_ l'item a des numero de serie!!
rstItem.Open "SELECT tblItem.AvecNoSerie FROM tblItem WHERE (tblItem.CodeMat = '" & pubCodeMat & "')", cnn, adOpenStatic
If (rstItem!AvecNoSerie) Then
'Ouverture de la fenetre de NoSerie action:codemat:qte:noclient
args = "pret;" & pubCodeMat & ";" & (iPretQte * rstGroupeItem!QTE) & ";" & pubNoClient
DoCmd.OpenForm "FrmPretNoSerie", , , , , acDialog, args
Else
Me!rNoSerieCheck = 1
End If
rstItem.Close
'Verification que les numeros de series sont passe vers le pret!
If (Me!rNoSerieCheck) Then
Me!rNoSerieCheck = Null
'Ouverture de la connection ADO sur la base de donnees courante sur le recordset defini
rstItem.Open "SELECT tblItem.* FROM tblItem WHERE (tblItem.CodeMat = '" & pubCodeMat & "')", cnn, adOpenStatic
rstItem.MoveFirst
rstPret.Open "SELECT tblPret.NoClient, tblPret.CodeMat, tblPret.Qte FROM tblPret WHERE (tblPret.NoClient = '" & pubNoClient & "')", cnn, adOpenStatic
'Validation si le client courant a des prets
If (rstPret.RecordCount > 0) Then
'lPret/rstPret/tblPret (relier au pubNoClient) n'est pas vide!
rstPret.MoveFirst
rstPret.Find "[CodeMat] = '" & pubCodeMat & "'"
'Vérification si le CodeMat sélectionné a été trouvé dans les prets. pour insert/update
If Not (rstPret.EOF) And Not (rstPret.BOF) Then
'PRET NON-VIDE ::: READY POUR UPDATE!!!!
If ((iPretQte * rstGroupeItem!QTE) <= rstItem!QteBalance) Then
DoCmd.RunSQL "UPDATE tblPret SET tblPret.Qte = " & iPretQte + rstPret!QTE & " WHERE ((tblPret.CodeMat = '" & pubCodeMat & "') AND (tblPret.NoClient = '" & pubNoClient & "'))"
DoCmd.RunSQL "UPDATE tblItem SET tblItem.QteBalance = " & rstItem!QteBalance - iPretQte & " WHERE (tblItem.CodeMat = '" & pubCodeMat & "')"
'DoCmd.RunSQL "UPDATE tblItem SET tblItem.QteEnPret = " & rstItem!QteEnPret + iPretQte & " WHERE (tblItem.CodeMat = '" & pubCodeMat & "')"
DoCmd.RunSQL "UPDATE tblPret SET tblPret.modDate = #" & Format(Date, "mm/dd/yyyy") & "# WHERE ((tblPret.CodeMat = '" & pubCodeMat & "') AND (tblPret.NoClient = '" & pubNoClient & "'))"
DoCmd.RunSQL "UPDATE tblPret SET tblPret.modTime = #" & Format(Time, "h:mm:s") & "# WHERE ((tblPret.CodeMat = '" & pubCodeMat & "') AND (tblPret.NoClient = '" & pubNoClient & "'))"
Else
MsgBox "Impossible de prêter plus d'item que la quantité disponible dans l'inventaire.", 16, "Erreur"
End If
Else
'PRET NON-VIDE ::: READY POUR INSERT!!!!
If ((iPretQte * rstGroupeItem!QTE) <= rstItem!QteBalance) Then
DoCmd.RunSQL "INSERT INTO tblPret (CodeMat, NoClient, Qte) VALUES ('" & pubCodeMat & "', '" & pubNoClient & "', " & (iPretQte * rstGroupeItem!QTE) & ")"
DoCmd.RunSQL "UPDATE tblItem SET tblItem.QteBalance = " & rstItem!QteBalance - (iPretQte * rstGroupeItem!QTE) & " WHERE (tblItem.CodeMat = '" & pubCodeMat & "')"
'DoCmd.RunSQL "UPDATE tblItem SET tblItem.QteEnPret = " & rstItem!QteEnPret + iPretQte & " WHERE (tblItem.CodeMat = '" & pubCodeMat & "')"
DoCmd.RunSQL "UPDATE tblPret SET tblPret.modDate = #" & Format(Date, "mm/dd/yyyy") & "# WHERE ((tblPret.CodeMat = '" & pubCodeMat & "') AND (tblPret.NoClient = '" & pubNoClient & "'))"
DoCmd.RunSQL "UPDATE tblPret SET tblPret.modTime = #" & Format(Time, "h:mm:s") & "# WHERE ((tblPret.CodeMat = '" & pubCodeMat & "') AND (tblPret.NoClient = '" & pubNoClient & "'))"
Else
MsgBox "Impossible de prêter plus d'item que la quantité disponible dans l'inventaire.", 16, "Erreur"
End If
End If
Else
'PRET VIDE ::: READY POUR INSERT!!!! (vierge)
If ((iPretQte * rstGroupeItem!QTE) <= rstItem!QteBalance) Then
DoCmd.RunSQL "INSERT INTO tblPret (CodeMat, NoClient, Qte) VALUES ('" & pubCodeMat & "', '" & pubNoClient & "', " & (iPretQte * rstGroupeItem!QTE) & ")"
DoCmd.RunSQL "UPDATE tblItem SET tblItem.QteBalance = " & rstItem!QteBalance - (iPretQte * rstGroupeItem!QTE) & " WHERE (tblItem.CodeMat = '" & pubCodeMat & "')"
'DoCmd.RunSQL "UPDATE tblItem SET tblItem.QteEnPret = " & rstItem!QteEnPret + iPretQte & " WHERE (tblItem.CodeMat = '" & pubCodeMat & "')"
DoCmd.RunSQL "UPDATE tblPret SET tblPret.modDate = #" & Format(Date, "mm/dd/yyyy") & "# WHERE ((tblPret.CodeMat = '" & pubCodeMat & "') AND (tblPret.NoClient = '" & pubNoClient & "'))"
DoCmd.RunSQL "UPDATE tblPret SET tblPret.modTime = #" & Format(Time, "h:mm:s") & "# WHERE ((tblPret.CodeMat = '" & pubCodeMat & "') AND (tblPret.NoClient = '" & pubNoClient & "'))"
Else
MsgBox "Impossible de prêter plus d'item que la quantité disponible dans l'inventaire.", 16, "Erreur"
End If
End If
rstPret.Close
rstItem.Close
rstGroupeItem.MoveNext
Else
GoTo OutOfLoop
End If
Loop
Else
MsgBox "Impossible"
End If
OutOfLoop:
Else
MsgBox "Impossible de trouver les éléments de ce groupe, veuillez en sélectionner un autre.", 16, "Erreur"
End If
rstGroupeItem.Close
Next itm
End If
'Insertion de la date du jour!
'ctl_tSignataireDate = Date
'Mise-a-jour de lGroupeItem, reset de tPretQte.Value et deselection de lItem
ctl_lItem.Requery
'ctl_lPret.RowSource = "SELECT tblPret.CodeMat, tblPret.Nomenclature, tblPret.Qte FROM tblPret WHERE (tblPret.NoClient = '" & pubNoClient & "')"
ctl_lPret.RowSource = "SELECT tblPret.CodeMat, tblPret.Qte, tblItem.ClassGrp, tblPret.CodeMat, tblItem.Nomenclature FROM tblItem INNER JOIN tblPret ON tblItem.CodeMat = tblPret.CodeMat WHERE (tblPret.NoClient = '" & pubNoClient & "')"
ctl_lPret.Requery
ctl_tPretQte = Null
strSource = ctl_lItem.RowSource
'ctl_lItem.RowSource = ""
ctl_lItem.RowSource = strSource
strSource = ctl_lPret.RowSource
ctl_lPret.RowSource = ""
ctl_lPret.RowSource = strSource
cnn.Close
Else
'SELECTION DANS ctl_lItem INEXISTANTE!! Message d'erreur!
MsgBox "Vous n'avez rien sélectionné pour prêter.", 16, "Erreur"
End If
Else
MsgBox "Impossible d'ajouter un prêt, il n'y a pas de destinataire (client).", 16, "Erreur"
End If
Exit_bPretAjouterItem_Click:
Exit Sub
Err_bPretAjouterItem_Click:
MsgBox Err.DESCRIPTION
Resume Exit_bPretAjouterItem_Click
End Sub |
Problème transformation zone de liste par zone de liste déroulante
Répondre avec citation
Partager