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
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
|
Option Explicit
Private Sub adrs_Click()
'UserForm1.plac.ListIndex = -1
End Sub
Private Sub adrs_Change()
Dim t, g
adst.Clear
If MultiPage1.Value = 1 Then
For t = 2 To finf5
If LCase(Feuil5.Cells(t, 3)) = LCase(adrs) Then adst.AddItem Feuil5.Cells(t, 4): adst.List(g, 1) = Feuil5.Cells(t, 2): adst.List(g, 2) = Feuil5.Cells(t, 1): g = g + 1
Next
End If
End Sub
Private Sub adrss_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
adrs = adrss
End Sub
Private Sub adst_Click()
TextBox1 = adst
End Sub
Private Sub aver6_Click()
End Sub
Private Sub comand_Click()
TextBox1 = comand
End Sub
Private Sub CommandButton1_Click()
Dim fin5 As Long, fin2 As Long
Dim repons
Dim prodd As Long
Dim placc
prodd = Xprod
If prodd = 0 Then averti6: Exit Sub
If IsDate(dat) = False Then averti4: Exit Sub
If adrs = "" Then averti2: Exit Sub
If Val(nbb) = 0 Then averti3: Exit Sub
If uniq.Value = True Then
If Not Feuil5.Range("c:c").Find(adrs) Is Nothing And xxplac = -1 Then repons = MsgBox("Already exist, continue ?", vbYesNo)
If repons = 7 Then Exit Sub
End If
placc = xxplac
If placc = -1 Then
fin5 = finf5
Feuil5.Cells(fin5, 1) = prod: Feuil5.Cells(fin5, 2) = Feuil1.Cells(prodd, 2): Feuil5.Cells(fin5, 3) = adrs: Feuil5.Cells(fin5, 4) = Val(nbb)
End If
Feuil1.Cells(prodd, 4) = Feuil1.Cells(prodd, 4) + Val(nbb): Feuil1.Cells(prodd, 6) = Feuil1.Cells(prodd, 6) + Val(nbb):
If placc > -1 Then Feuil5.Cells(placc, 4) = Feuil5.Cells(placc, 4) + Val(nbb)
fin2 = finf2
Feuil2.Cells(fin2, 1) = CDate(dat): Feuil2.Cells(fin2, 2) = TextBox1.Text: Feuil2.Cells(fin2, 3) = Val(nbb): Feuil2.Cells(fin2, 4) = adrs: vide
End Sub
Private Sub CommandButton10_Click()
UserForm1.Hide
Feuil5.PrintPreview
UserForm1.Show
End Sub
Private Sub CommandButton11_Click()
Feuil5.Range("A1:d" & finf5 - 1).Sort Key1:=Feuil5.Range("C1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub
Private Sub CommandButton12_Click()
UserForm1.Hide
Feuil1.PrintPreview
UserForm1.Show
End Sub
Private Sub CommandButton13_Click()
Application.Dialogs(xlDialogPrinterSetup).Show
End Sub
Private Sub CommandButton14_Click()
Dim a, b, c, d, e, f
a = Application.GetSaveAsFilename("")
If a = False Or a = "" Then Exit Sub
b = Feuil1.Name
c = Feuil2.Name
d = Feuil3.Name
e = Feuil5.Name
f = Feuil7.Name
If Right(a, 3) <> "xls" Then a = a & ".xls"
Sheets(Array(b, c, d, e, f)).Select
Sheets(Array(b, c, d, e, f)).Copy
ActiveWorkbook.SaveAs Filename:=a, FileFormat:=xlNormal
ActiveWorkbook.Close
Feuil6.Select
End Sub
Private Sub CommandButton15_Click()
Dim ty
Feuil10.Cells.ClearContents
If MultiPage1.Value = 1 Then
Feuil10.Range("A1") = adrs
Feuil10.Range("A2") = "Codes"
Feuil10.Range("B2") = "Articles"
Feuil10.Range("c2") = "NB"
For ty = 0 To adst.ListCount - 1
Feuil10.Cells(ty + 3, 1) = adst.List(ty, 2)
Feuil10.Cells(ty + 3, 2) = adst.List(ty, 1)
Feuil10.Cells(ty + 3, 3) = adst.List(ty, 0)
Next
End If
If MultiPage1.Value = 0 Then
If TextBox1 = "" Then UserForm1.Show: Exit Sub
Feuil10.Range("A1") = intil
Feuil10.Range("A2") = "NB"
Feuil10.Range("B2") = "Adresses"
Feuil10.Range("C2") = ""
For ty = 0 To plac.ListCount - 1
Feuil10.Cells(ty + 3, 1) = plac.List(ty, 0)
Feuil10.Cells(ty + 3, 2) = plac.List(ty, 1)
Next
End If
If MultiPage1.Value = 2 Then
Feuil10.Range("A1") = "COMMANDE"
Feuil10.Range("A2") = "Codes"
Feuil10.Range("B2") = "Articles"
Feuil10.Range("C2") = "Reste"
For ty = 0 To comand.ListCount - 1
Feuil10.Cells(ty + 3, 1) = comand.List(ty, 2)
Feuil10.Cells(ty + 3, 2) = comand.List(ty, 1)
Feuil10.Cells(ty + 3, 3) = comand.List(ty, 0)
Next
End If
Feuil10.Range("A2:C10000").Sort Key1:=Feuil10.Range("B2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
change = False
UserForm1.Hide
Feuil10.PrintPreview
UserForm1.Show
End Sub
Private Sub CommandButton16_Click()
Dim X As Long, Y As Long, d As Integer, p As Integer
Y = 3
Feuil4.Range("A3:e" & finf4).ClearContents
Feuil4.Range("A1") = "Mouvements article: " + intil
For X = 2 To finf2
If Feuil2.Cells(X, 2) = prod Then
For d = 1 To 4
If d = 4 Then p = 1
Feuil4.Cells(Y, d + p) = Feuil2.Cells(X, d)
Next
Feuil4.Cells(Y, 2) = "Entrée": Y = Y + 1
End If
Next
For X = 2 To finf3
If Feuil3.Cells(X, 2) = prod Then
For d = 1 To 5: Feuil4.Cells(Y, d) = Feuil3.Cells(X, d): Next
Feuil4.Cells(Y, 2) = "Sortie": Y = Y + 1
End If
Next
For X = 2 To finf7
If Feuil7.Cells(X, 2) = prod Then
For d = 1 To 5: Feuil4.Cells(Y, d) = Feuil7.Cells(X, d): Next
Feuil4.Cells(Y, 2) = "Déplacement": Y = Y + 1
End If
Next
Feuil4.Range("A2:e" & finf4).Sort Key1:=Feuil4.Range("a2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
UserForm1.Hide
Feuil4.PrintPreview
UserForm1.Show
End Sub
Private Sub CommandButton17_Click()
Dim a
a = Replace(Feuil1.Range("a1").End(xlToRight).Address, "1", "")
Feuil1.Range("a1:" & a & finf1 - 1).Sort Key1:=Feuil1.Range("a1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
dico1
lifour
End Sub
'**********************************************
'**********************************************
Private Sub CommandButton18_Click()
Dim a
a = Replace(Feuil1.Range("a1").End(xlToRight).Address, "1", "")
Feuil1.Range("a1:" & a & finf1 - 1).Sort Key1:=Feuil1.Range("b1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
dico1
lifour
End Sub
Private Sub CommandButton2_Click()
Dim fin3 As Long
Dim placc
Dim prodd As Long
'Dim vl1 As Double, vl2 As Double, vl3 As Double, vl4 As Double
prodd = Xprod
If prodd = 0 Then Exit Sub
If plac.ListIndex = -1 Then averti1: Exit Sub
If Val(nbb) = 0 Then averti3: Exit Sub
If adrs = "" Then averti2: Exit Sub
If adrs = plac Then averti5: Exit Sub
If IsDate(dat) = False Then averti4: Exit Sub
placc = xplac
If Feuil5.Cells(placc, 4) < Val(nbb) Then MsgBox ("Not Possible " & Chr(10) & "You can't, check your data"): Exit Sub
If placc > -1 Then Feuil5.Cells(placc, 4) = Feuil5.Cells(placc, 4) - Val(nbb)
If Feuil5.Cells(placc, 4) = 0 Then Feuil5.Rows(placc).Delete
Feuil1.Cells(prodd, 5) = Feuil1.Cells(prodd, 5) + Val(nbb): Feuil1.Cells(prodd, 6) = Feuil1.Cells(prodd, 6) - Val(nbb):
fin3 = finf3
Feuil3.Cells(fin3, 1) = CDate(dat): Feuil3.Cells(fin3, 2) = TextBox1.Text: Feuil3.Cells(fin3, 3) = Val(nbb): Feuil3.Cells(fin3, 4) = plac: Feuil3.Cells(fin3, 5) = adrs: vide
End Sub
Private Sub CommandButton3_Click()
Dim fin7 As Long
Dim f As Integer, g As Integer
Dim repons
Dim fin5 As Long
Dim prodd As Long
prodd = Xprod
If prodd = 0 Then averti6: Exit Sub
If plac.ListIndex = -1 Then averti1: Exit Sub
If adrs = "" Then averti2: Exit Sub
If adrs = plac Then averti5: Exit Sub
If Val(nbb) = 0 Then averti3: Exit Sub
If IsDate(dat) = False Then averti4: Exit Sub
If uniq = True Then
If Not Feuil5.Range("c:c").Find(adrs) Is Nothing And xxplac = -1 Then repons = MsgBox("DEJA OCCUPE, SOUHAITEZ VOUS FORCER", vbYesNo)
If repons = 7 Then Exit Sub
End If
f = xxplac: g = plac.List(plac.ListIndex, 2)
If Val(nbb) <= Val(plac.List(plac.ListIndex, 0)) Then
Feuil5.Cells(g, 4) = Feuil5.Cells(g, 4) - Val(nbb)
If f = -1 Then
fin5 = finf5
Feuil5.Cells(fin5, 1) = prod: Feuil5.Cells(fin5, 2) = Feuil1.Cells(prodd, 2): Feuil5.Cells(fin5, 3) = adrs: Feuil5.Cells(fin5, 4) = Val(nbb)
End If
If f > -1 Then Feuil5.Cells(f, 4) = Feuil5.Cells(f, 4) + Val(nbb)
Else
MsgBox ("IMPOSSIBLE " & Chr(10) & "You can't, check your data"): Exit Sub
End If
If Feuil5.Cells(g, 4) = 0 Then Feuil5.Rows(g).Delete
fin7 = finf7
Feuil7.Cells(fin7, 1) = CDate(dat): Feuil7.Cells(fin7, 2) = TextBox1.Text: Feuil7.Cells(fin7, 5) = adrs: Feuil7.Cells(fin7, 4) = plac: Feuil7.Cells(fin7, 3) = Val(nbb): vide
End Sub
Private Sub CommandButton4_Click()
UserForm2.Show
End Sub
Private Sub CommandButton5_Click()
dat = Date
End Sub
Private Sub CommandButton6_Click()
End
End Sub
Private Sub CommandButton8_Click()
If Val(rest.Caption) > 0 Then MsgBox ("VOUS DEVEZ SORTIR TOUS LES PRODUITS"): Exit Sub
If Xprod = 0 Then MsgBox ("Select your Item"): Exit Sub
Feuil1.Rows(Xprod).Delete
lifour
dico1
TextBox1 = ""
End Sub
Private Sub CommandButton9_Click()
Dim derligne As String
Dim a
Dim f As Long
a = MsgBox("Want you remove entries,modifictions ?", vbYesNo)
If a = 7 Then Exit Sub
For f = 2 To finf1
Feuil1.Cells(f, 3) = Feuil1.Cells(f, 6)
Next
With Feuil2
derligne = .Range("a65536").End(xlUp).Row
If derligne > 1 Then .Range("a2:E" & derligne).ClearContents
End With
With Feuil3
derligne = .Range("a65536").End(xlUp).Row
If derligne > 1 Then .Range("a2:E" & derligne).ClearContents
End With
With Feuil7
derligne = .Range("a65536").End(xlUp).Row
If derligne > 1 Then .Range("a2:E" & derligne).ClearContents
End With
With Feuil1
derligne = .Range("a65536").End(xlUp).Row
If derligne > 1 Then .Range("d2:E" & derligne).ClearContents
End With
TextBox1 = ""
End Sub
Private Sub fotto_Click()
fotto.Visible = False
End Sub
Private Sub intil_Change()
End Sub
Private Sub Label17_Click()
End Sub
Private Sub MultiPage1_Change()
Dim t, g
If MultiPage1.Value = 1 Then
adst.Clear
For t = 2 To finf5
If LCase(Feuil5.Cells(t, 3)) = LCase(adrs) Then adst.AddItem Feuil5.Cells(t, 4): adst.List(g, 1) = Feuil5.Cells(t, 2): adst.List(g, 2) = Feuil5.Cells(t, 1): g = g + 1
Next
End If
If MultiPage1.Value = 2 Then
comand.Clear
For t = 2 To finf1 - 1
If Feuil1.Cells(t, 6) <= Feuil1.Cells(t, 11) Then comand.AddItem Feuil1.Cells(t, 6): comand.List(g, 1) = Feuil1.Cells(t, 2): comand.List(g, 2) = Feuil1.Cells(t, 1): comand.List(g, 3) = t: g = g + 1
Next
End If
End Sub
Private Sub nbb_Change()
End Sub
Private Sub plac_Click()
adrs.Value = plac
End Sub
Private Sub prode_Click()
MultiPage1.Value = 0
TextBox1 = prode.Value
nbb = ""
If prode.ListIndex > -1 And fotto.Visible = True Then
fotto.Picture = LoadPicture("")
fot = Feuil1.Cells(Xprod, 10)
If fs.FileExists(fot) = True Then fotto.Picture = LoadPicture(fot)
fotto.Visible = True
End If
End Sub
Private Sub prode_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
lign = Xprod
If lign = 0 Or lign = 1 Then Exit Sub
nouvv.Show
End Sub
Private Sub prode_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 And Xprod > 0 Then
fotto.Picture = LoadPicture("")
fot = Feuil1.Cells(Xprod, 10)
If fs.FileExists(fot) = True Then fotto.Picture = LoadPicture(fot)
fotto.Visible = True
End If
End Sub
Private Sub ScrollBar1_Change()
fotto.Width = ScrollBar1.Value
fotto.Height = ScrollBar1.Value * 0.8
ScrollBar1.Width = fotto.Width - 2
End Sub
Private Sub TextBox1_Change()
Dim ff
prod = TextBox1
ff = Xprod
plac.Clear
If ff = 0 Then intil = " Does not exist in current data": nbe = "": nbs = "": rest = "": Exit Sub
intil = Feuil1.Cells(ff, 2)
nbe = Feuil1.Cells(ff, 4)
nbs = Feuil1.Cells(ff, 5)
rest = Feuil1.Cells(ff, 6)
lesplace
End Sub
Private Sub TextBox2_Change()
End Sub
Private Sub uniq_Click()
Feuil6.Range("r1").Value = uniq
End Sub
Private Sub UserForm_Activate()
If change = False Then change = True: Exit Sub
lifour
End Sub
Public Sub vide()
Dim a
a = TextBox1.Text
adrs = ""
TextBox1 = ""
TextBox1 = a
End Sub
Public Sub lesplace()
Dim c, t
plac.Clear
With Feuil5.Range("a:a")
Set c = .Find(prod, LookIn:=xlValues)
If Not c Is Nothing Then
t = c.Row
Do
If .Cells(c.Row, 1) = prod Then
plac.AddItem .Cells(c.Row, 4)
plac.List(plac.ListCount - 1, 1) = .Cells(c.Row, 3)
plac.List(plac.ListCount - 1, 2) = c.Row
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Row <> t
End If
End With
If plac.ListCount = 1 Then plac.ListIndex = 0
End Sub
Private Sub UserForm_Initialize()
Dim derligne As Long, tablo
Set pro = CreateObject("Scripting.Dictionary")
Set fs = CreateObject("Scripting.FileSystemObject")
uniq = Feuil6.Range("r1").Value
dat = Date
change = True
With Feuil8
derligne = .Range("a65536").End(xlUp).Row
tablo = .Range("a2:a" & derligne)
adrss.List = tablo
End With
dico1
fotto.Visible = False
End Sub
Public Sub lifour()
Dim tablo As Variant
Dim derligne As Long
With Feuil1
If .AutoFilterMode Then .Cells.AutoFilter
MultiPage1.Value = 0
prode.Clear
derligne = .Range("a65536").End(xlUp).Row
tablo = Feuil1.Range("a2:c" & derligne)
prode.List = tablo
If IsArray(tablo) = True Then prode.List = tablo
End With
End Sub |
) :
Répondre avec citation
Partager