aide code VBA - User Form

**Mariec_06** · 28/09/2015, 15h58

Bonjour,

Ne connaissant absolument rien a la programmation, j'ai quand meme reussit a construire un formulaire de consultation / entrée de donnees qui tient a peu pres la route et marche plus ou moins correctement. Toutefois j'ai encore des "bugs" que je ne sais pas du tout fixer.

Voici le fichier Excel en question dans lequel j'ai remplace les donnees par leur format et auquel est attaché un formulaire (form1) qui va piocher/updater les infos dans les 2 feuilles de calcul un peu partout. Le bouton "add" et "print" marche a la perfection.

Toutefois voila ce pourquoi j'aurai besoin d'aide dans mon formulaire:

- je voudrais trier mes donnees par mois, sachant qu'il y a plus d'une reference (ref= "2015CT001"/"2015CT002" etc) par mois mais que les mois ne sont pas consecutif, cad que par ex 2015CT002 peut etre de janvier alors que 2015CT001 peut etre de fevrier, c pkoi je garde le tableau classe par reference seulement et pas par mois. Donc je voudrais dans mon formulaire, si je clique janvier ils m'apparaissent toutes les references concernees pour janvier. Pour naviguer parmi ces references, je voudrais pouvoir utiliser le bouton "next".

- je voudrais aussi que le bouton "next" me fasse passer a la reference suivante (sauf en cas de tri par mois ou dans ce cas, il me ferait passer a la prochaine reference du mois

donc

1 er cas, si je suis sur la fiche "2015CT025" et que je clique sur "next" je passe automatiquement sur la fiche "2015CT026"

2eme cas si j'ai fait une recherché par mois ils me fassent passer de la reference "2015CT003" (JANVIER) a la reference "2015CT005" (Suivante reference du mois de janvier).

j'ai donc besoin d'aide pour le code me permettant de:

- trier mes donnees par mois selectionne
- utiliser le bouton next pour naviguer

Je rappelle que les boites du formulaire sont alimentees certaines par la feuille "recap" d'autres par "pricing final"

toutes suggestions sur le code deja existant (particulierement sur les formats des cellules chiffrees et date) sont les bienvenue

Merci d'avance a ceux qui vont passer du temps a m'aider

Pour info si utile , le classeur original que j'utilise a bien plus de reference repartie sur toute l'annee (jusqu'a 100)

**kiki29** · 29/09/2015, 06h43

Salut, à lire

**pasdechances** · 29/09/2015, 09h41

bonjour,

Voici qui devrai nous aider a comprendre ta demande exécute se petit passage voir si c'est correcte et dit nous le résultat :

Code :

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

1
2
3
4
5
6
7
8
9
Sub question()
If MsgBox("Tu veux de l'aide pour qu'on te fasse le boulot ?", vbYesNo, "que veux tu réelement ?") = vbNo Then
    MsgBox "je te prierai de bien vouloir nous exposer ton code" & _
             "(en te servant des balises faites pour) et nous dire" & _
             "ou tu bloque afin que l'on puisse t'aider =).", vbOKOnly, ""
    Else
    MsgBox "il te reste les tutos ou les esclaves. ", vbOKOnly, ""
End If
End Sub

**Mariec_06** · 30/09/2015, 08h13

J'ai fait enormement de forum essaye enormement de codes depuis 3 semaines tous les jours mais malheureusement je ne sais pas les adapter au mien

Mais bon j'ai compris le message tant pis pour moi

**pasdechances** · 30/09/2015, 10h07

e problème n'est pas la, on est sur le forum pour s'entraider, les demandes qui ressemble a la tienne, sont en générale faites pour que se soit le foromeur helper qui fasse tout le travail gratuitement.
Du coup on prend assez mal se genre d'annonces, montre nous ton code au lieu de ton fichier et on va essayer de t'apprend ainsi, mais ne compte pas sur nous pour te fournir du tout cuit.
si tu ne comprend pas les cours disponible fait le nous savoir, on t'expliquera et on t'aidera, on est la pour ça =).

**Mariec_06** · 30/09/2015, 10h40

Je pensais que le code etait accessible par le fichier

voila le code actuel qui fonctionne tres bien pour consulter/modifier les "fiches" ainsi qu'imprimer le formulaire

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
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
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
 
Private Sub BL_GROSS_QTY_Exit(ByVal Cancel As MSForms.ReturnBoolean)
BL_GROSS_QTY.Value = Format(BL_GROSS_QTY.Value, "#,##0.000")
 
End Sub
 
Private Sub CommandButton2_Click()
'BOITE DE DIALOGUE POUR LA DEMANDE D'IMPRESSION
Dim IPVM
  IPVM = MsgBox("do you want to print DEALSHEET", vbYesNo + vbDefaultButton2 + vbQuestion, " DEMANDE D'IMPPRESSION")
  If IPVM = vbNo Then Exit Sub
 
  If IPVM = vbYes Then
        Application.ScreenUpdating = False
        DoEvents
        keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
        keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
        keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
        keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
        DoEvents
        Workbooks.Add
        Application.Wait Now + TimeValue("00:00:01")
        With ActiveSheet
            .PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
            .Range("A1").Activate
        .PageSetup.CenterHeader = ""
        .PageSetup.RightHeader = ""
        .PageSetup.LeftFooter = ""
        .PageSetup.CenterFooter = ""
        .PageSetup.RightFooter = ""
        .PageSetup.LeftMargin = Application.InchesToPoints(0)
        .PageSetup.RightMargin = Application.InchesToPoints(0)
        .PageSetup.TopMargin = Application.InchesToPoints(0#)
        .PageSetup.BottomMargin = Application.InchesToPoints(0)
        .PageSetup.HeaderMargin = Application.InchesToPoints(0)
        .PageSetup.FooterMargin = Application.InchesToPoints(0)
        .PageSetup.PrintHeadings = False
        .PageSetup.PrintGridlines = False
        .PageSetup.PrintComments = xlPrintNoComments
        .PageSetup.PrintQuality = 600
        .PageSetup.CenterHorizontally = True
        .PageSetup.CenterVertically = True
        .PageSetup.Orientation = xlLandscape
        .PageSetup.Draft = False
        .PageSetup.PaperSize = xlPaperA4
        .PageSetup.FirstPageNumber = xlAutomatic
        .PageSetup.Order = xlDownThenOver
        .PageSetup.BlackAndWhite = False
        .PageSetup.Zoom = 70
        .PageSetup.PrintErrors = xlPrintErrorsDisplayed
        .PageSetup.OddAndEvenPagesHeaderFooter = False
        .PageSetup.DifferentFirstPageHeaderFooter = False
        .PageSetup.ScaleWithDocHeaderFooter = True
        .PageSetup.AlignMarginsHeaderFooter = True
        .PageSetup.EvenPage.LeftHeader.Text = ""
        .PageSetup.EvenPage.CenterHeader.Text = ""
        .PageSetup.EvenPage.RightHeader.Text = ""
        .PageSetup.EvenPage.LeftFooter.Text = ""
        .PageSetup.EvenPage.CenterFooter.Text = ""
        .PageSetup.EvenPage.RightFooter.Text = ""
        .PageSetup.FirstPage.LeftHeader.Text = ""
        .PageSetup.FirstPage.CenterHeader.Text = ""
        .PageSetup.FirstPage.RightHeader.Text = ""
        .PageSetup.FirstPage.LeftFooter.Text = ""
        .PageSetup.FirstPage.CenterFooter.Text = ""
        .PageSetup.FirstPage.RightFooter.Text = ""
           End With
        ActiveWindow.SelectedSheets.PrintOut Copies:=1
        ActiveWorkbook.Close False
        CommandButton2.SetFocus
        Application.ScreenUpdating = True
  End If
End Sub
 
Private Sub REF_Change()
Dim iRow As Long
Dim iRow1 As Long
Dim Wsh As Worksheet
Dim Wsh1 As Worksheet
Dim SEARCH_I As String
Dim MONTH As String
Dim REF As String
Dim OIC As String
Dim VSL As String
Dim GRADE As String
Dim LP As String
Dim DP As String
Dim SUPPLIER As String
Dim TERM_P As String
Dim CT_QTY As String
Dim TOLERANCE As String
Dim CT_DATES_TERM As String
Dim CT_DATES As String
Dim PRICING_P As String
Dim PMT_P As String
Dim PREM_P As String
Dim OSP_P As String
Dim INV_QTY_P As String
Dim LP_INSP As String
Dim LP_INSP_SHARING As String
Dim LP_AGT As String
Dim LP_AGT_CATEGORY As String
Dim RCVRS As String
Dim TERM_S As String
Dim REQ_MIN_QTY As String
Dim REQ_MAX_QTY As String
Dim PRICING_S As String
Dim PMT_S As String
Dim PREM_S As String
Dim OSP_S As String
Dim INV_QTY_S As String
Dim DP_INSP As String
Dim DP_INSP_SHARING As String
Dim DP_AGT As String
Dim DP_AGT_CATEGORY As String
Dim MIN_FRT_QTY As String
Dim WS As String
Dim BL_DATE As String
Dim BL_NET_QTY As String
Dim BL_GROSS_QTY As Long
Dim COD_DATE As String
Dim OT_QTY As String
Dim ROW_NR As String
 
Set Wsh = Worksheets("RECAP")
Set Wsh1 = Worksheets("PRICING FINAL")
 
SEARCH_I = Me.REF.Value
 
'find first empty row in database
iRow = Wsh.Cells.Find(What:=SEARCH_I, SearchOrder:=xlRows, _
    SEARCHDIRECTION:=xlPrevious, LookIn:=xlValues).Row
iRow1 = Wsh1.Cells.Find(What:=SEARCH_I, SearchOrder:=xlRows, _
    SEARCHDIRECTION:=xlPrevious, LookIn:=xlValues).Row
 
 
'copy the data to the database
'use protect and unprotect lines,
'     with your password
'     if worksheet is protected
REF = Me.REF.Value
MONTH = Wsh.Cells(iRow, "A").Value
OIC = Wsh.Cells(iRow, "D").Value
GRADE = Wsh.Cells(iRow, "F").Value
VSL = Wsh.Cells(iRow, "E").Value
LP = Wsh.Cells(iRow, "G").Value
DP = Wsh.Cells(iRow, "Y").Value
SUPPLIER = Wsh.Cells(iRow, "L").Value
TERM_P = Wsh.Cells(iRow, "M").Value
CT_QTY = Wsh.Cells(iRow, "I").Value
TOLERANCE = Wsh.Cells(iRow, "J").Value
CT_DATES_TERM = Wsh.Cells(iRow, "N").Value
CT_DATES = Wsh.Cells(iRow, "O").Value
PRICING_P = Wsh1.Cells(iRow1, "O").Value
PMT_P = Wsh1.Cells(iRow1, "P").Value
PREM_P = Wsh1.Cells(iRow1, "S").Value
OSP_P = Wsh1.Cells(iRow1, "R").Value
INV_QTY_P = Wsh1.Cells(iRow1, "M").Value
LP_INSP = Wsh.Cells(iRow, "R").Value
LP_INSP_SHARING = Wsh.Cells(iRow, "S").Value
LP_AGT = Wsh.Cells(iRow, "U").Value
LP_AGT_CATEGORY = Wsh.Cells(iRow, "V").Value
RCVRS = Wsh.Cells(iRow, "W").Value
TERMS_S = Wsh.Cells(iRow, "X").Value
REQ_MIN_QTY = Wsh.Cells(iRow, "Z").Value
REQ_MAX_QTY = Wsh.Cells(iRow, "AA").Value
PRICING_S = Wsh1.Cells(iRow1, "AG").Value
PMT_S = Wsh1.Cells(iRow1, "AH").Value
PREM_S = Wsh1.Cells(iRow1, "AK").Value
OSP_S = Wsh1.Cells(iRow1, "AJ").Value
INV_QTY_S = Wsh1.Cells(iRow1, "AE").Value
DP_INSP = Wsh.Cells(iRow, "AD").Value
DP_INSP_SHARING = Wsh.Cells(iRow, "AE").Value
DP_AGT = Wsh.Cells(iRow, "AG").Value
DP_AGT_CATEGORY = Wsh.Cells(iRow, "AH").Value
MIN_FRT_QTY = Wsh1.Cells(iRow1, "BB").Value
WS = Wsh1.Cells(iRow1, "BC").Value
BL_DATE = Wsh.Cells(iRow, "AI").Value
BL_NET_QTY = Wsh.Cells(iRow, "AL").Value
BL_GROSS_QTY = Wsh.Cells(iRow, "AK").Value
COD_DATE = Wsh.Cells(iRow, "AJ").Value
OT_QTY = Wsh.Cells(iRow, "AM").Value
ROW_NR = Right(Me.REF.Value, 3)
 
'  .Protect Password:="password"
Me.REF.Value = REF
Me.MONTH.Value = MONTH
Me.VSL.Value = VSL
Me.OIC.Value = OIC
Me.GRADE.Value = GRADE
Me.LP.Value = LP
Me.DP.Value = DP
Me.SUPPLIER.Value = SUPPLIER
Me.TERM_P.Value = TERM_P
Me.CT_QTY.Value = CT_QTY
Me.TOLERANCE.Value = TOLERANCE
Me.CT_DATES_TERM.Value = CT_DATES_TERM
Me.CT_DATES.Value = CT_DATES
Me.PRICING_P.Value = PRICING_P
Me.PMT_P.Value = PMT_P
Me.PREM_P.Value = PREM_P
Me.OSP_P.Value = OSP_P
Me.INV_QTY_P.Value = INV_QTY_P
Me.LP_INSP.Value = LP_INSP
Me.LP_INSP_SHARING.Value = LP_INSP_SHARING
Me.LP_AGT.Value = LP_AGT
Me.LP_AGT_CATEGORY.Value = LP_AGT_CATEGORY
Me.RCVRS.Value = RCVRS
Me.TERMS_S.Value = TERMS_S
Me.REQ_MIN_QTY.Value = REQ_MIN_QTY
Me.REQ_MAX_QTY.Value = REQ_MAX_QTY
Me.PRICING_S.Value = PRICING_S
Me.PMT_S.Value = PMT_S
Me.PREM_S.Value = PREM_S
Me.OSP_S.Value = OSP_S
Me.INV_QTY_S.Value = INV_QTY_S
Me.DP_INSP.Value = DP_INSP
Me.DP_INSP_SHARING.Value = DP_INSP_SHARING
Me.DP_AGT.Value = DP_AGT
Me.DP_AGT_CATEGORY.Value = DP_AGT_CATEGORY
Me.MIN_FRT_QTY.Value = MIN_FRT_QTY
Me.WS.Value = WS
Me.BL_DATE.Value = BL_DATE
Me.BL_NET_QTY.Value = BL_NET_QTY
Me.BL_GROSS_QTY.Value = BL_GROSS_QTY
Me.COD_DATE.Value = COD_DATE
Me.OT_QTY.Value = OT_QTY
Me.ROW_NR.Value = ROW_NR
'clear the data
 
End Sub
 
Private Sub cmdAdd_Click()
Dim iRow As Long
Dim iRow1 As Long
Dim Wsh As Worksheet
Dim Wsh1 As Worksheet
Dim SEARCH_I As String
 
Dim MONTH As String
Dim REF As String
Dim OIC As String
Dim VSL As String
Dim GRADE As String
Dim LP As String
Dim DP As String
Dim SUPPLIER As String
Dim TERM_P As String
Dim CT_QTY As String
Dim TOLERANCE As String
Dim CT_DATES_TERM As String
Dim CT_DATES As String
Dim PRICING_P As String
Dim PMT_P As String
Dim PREM_P As String
Dim OSP_P As String
Dim INV_QTY_P As String
Dim LP_INSP As String
Dim LP_INSP_SHARING As String
Dim LP_AGT As String
Dim LP_AGT_CATEGORY As String
Dim RCVRS As String
Dim TERM_S As String
Dim REQ_MIN_QTY As String
Dim REQ_MAX_QTY As String
Dim PRICING_S As String
Dim PMT_S As String
Dim PREM_S As String
Dim OSP_S As String
Dim INV_QTY_S As String
Dim DP_INSP As String
Dim DP_INSP_SHARING As String
Dim DP_AGT As String
Dim DP_AGT_CATEGORY As String
Dim MIN_FRT_QTY As String
Dim WS As String
Dim BL_DATE As String
Dim BL_NET_QTY As String
Dim BL_GROSS_QTY As Long
Dim COD_DATE As String
Dim OT_QTY As String
 
MONTH = Me.MONTH.Value
REF = Me.REF.Value
OIC = Me.OIC.Value
GRADE = Me.GRADE.Value
VSL = Me.VSL.Value
LP = Me.LP.Value
DP = Me.DP.Value
SUPPLIER = Me.SUPPLIER.Value
TERM_P = Me.TERM_P.Value
CT_QTY = Me.CT_QTY.Value
TOLERANCE = Me.TOLERANCE.Value
CT_DATES_TERM = Me.CT_DATES_TERM.Value
CT_DATES = Me.CT_DATES.Value
CT_DATES = Me.CT_DATES.Text
PRICING_P = Me.PRICING_P.Value
PMT_P = Me.PMT_P.Value
PREM_P = Me.PREM_P.Value
OSP_P = Me.OSP_P.Value
INV_QTY_P = Me.INV_QTY_P.Value
LP_INSP = Me.LP_INSP.Value
LP_INSP_SHARING = Me.LP_INSP_SHARING.Value
LP_AGT = Me.LP_AGT.Value
LP_AGT_CATEGORY = Me.LP_AGT_CATEGORY.Value
RCVRS = Me.RCVRS.Value
TERMS_S = Me.TERMS_S.Value
REQ_MIN_QTY = Me.REQ_MIN_QTY.Value
REQ_MAX_QTY = Me.REQ_MAX_QTY.Value
PRICING_S = Me.PRICING_S.Value
PMT_S = Me.PMT_S.Value
PREM_S = Me.PREM_S.Value
OSP_S = Me.OSP_S.Value
INV_QTY_S = Me.INV_QTY_S.Value
DP_INSP = Me.DP_INSP.Value
DP_INSP_SHARING = Me.DP_INSP_SHARING.Value
DP_AGT = Me.DP_AGT.Value
DP_AGT_CATEGORY = Me.DP_AGT_CATEGORY.Value
MIN_FRT_QTY = Me.MIN_FRT_QTY.Value
WS = Me.WS.Value
BL_DATE = Me.BL_DATE.Value
BL_NET_QTY = Me.BL_NET_QTY.Value
BL_GROSS_QTY = Me.BL_GROSS_QTY.Value
COD_DATE = Me.COD_DATE.Value
OT_QTY = Me.OT_QTY.Value
 
Set Wsh = Worksheets("RECAP")
Set Wsh1 = Worksheets("PRICING FINAL")
 
SEARCH_I = Me.REF.Value
 
'find first empty row in database
iRow = Wsh.Cells.Find(What:=SEARCH_I, SearchOrder:=xlRows, _
    SEARCHDIRECTION:=xlPrevious, LookIn:=xlValues).Row
iRow1 = Wsh1.Cells.Find(What:=SEARCH_I, SearchOrder:=xlRows, _
    SEARCHDIRECTION:=xlPrevious, LookIn:=xlValues).Row
 
'copy the data to the database
'use protect and unprotect lines,
'     with your password
'     if worksheet is protected
With Wsh
'  .Unprotect Password:="password"
  .Cells(iRow, "A").Value = MONTH
  .Cells(iRow, "C").Value = REF
  .Cells(iRow, "D").Value = OIC
  .Cells(iRow, "F").Value = GRADE
.Cells(iRow, "E").Value = VSL
.Cells(iRow, "G").Value = LP
.Cells(iRow, "Y").Value = DP
.Cells(iRow, "L").Value = SUPPLIER
.Cells(iRow, "M").Value = TERM_P
.Cells(iRow, "I").Value = CT_QTY
.Cells(iRow, "J").Value = TOLERANCE
.Cells(iRow, "N").Value = CT_Dates_Terms
.Cells(iRow, "O").Value = CT_DATES
.Cells(iRow1, "O").Value = PRICING_P
.Cells(iRow1, "P").Value = PMT_P
.Cells(iRow1, "S").Value = PREM_P
.Cells(iRow1, "R").Value = OSP_P
.Cells(iRow1, "M").Value = INV_QTY_P
.Cells(iRow, "R").Value = LP_INSP
.Cells(iRow, "S").Value = LP_INSP_SHARING
.Cells(iRow, "U").Value = LP_AGT
.Cells(iRow, "V").Value = LP_AGT_CATEGORY
.Cells(iRow, "W").Value = RCVRS
.Cells(iRow, "X").Value = TERMS_S
.Cells(iRow, "Z").Value = REQ_MIN_QTY
.Cells(iRow, "AA").Value = REQ_MAX_QTY
.Cells(iRow1, "AG").Value = PRICING_S
.Cells(iRow1, "AH").Value = PMT_S
.Cells(iRow1, "AK").Value = PREM_S
.Cells(iRow1, "AJ").Value = OSP_S
.Cells(iRow1, "AE").Value = INV_QTY_S
.Cells(iRow, "AD").Value = DP_INSP
.Cells(iRow, "AE").Value = DP_INSP_SHARING
.Cells(iRow, "AG").Value = DP_AGT
.Cells(iRow, "AH").Value = DP_AGT_CATEGORY
.Cells(iRow1, "BB").Value = MIN_FRT_QTY
.Cells(iRow1, "BC").Value = WS
.Cells(iRow, "AI").Value = BL_DATE
.Cells(iRow, "AL").Value = BL_NET_QTY
.Cells(iRow, "AK").Value = BL_GROSS_QTY
.Cells(iRow, "AJ").Value = COD_DATE
.Cells(iRow, "AM").Value = OT_QTY
 
'  .Protect Password:="password"
End With
 
'clear the data
Me.MONTH.Value = ""
Me.REF.Value = ""
Me.REF.SetFocus
End Sub
Private Sub CT_QTY_Change()
CT_QTY.Value = Format(CT_QTY.Value, "#,##0.00 ;-#,##0.00")
End Sub
Private Sub OSP_P_Change()
OSP_P.Value = Format(OSP_P.Value, "#,##0.000 ;-#,##0.000")
End Sub
Private Sub PREM_S_Change()
PREM_S.Value = Format(PREM_S.Value, "0.000")
End Sub
Private Sub PREM_S_AfterUpdate()
PREM_S.Text = Format(PREM_S.Text, "0.000")
End Sub
Private Sub OSP_S_Change()
OSP_S.Value = Format(OSP_S.Value, "#,##0.000 ;-#,##0.000")
End Sub
Private Sub MIN_FRT_QTY_Change()
MIN_FRT_QTY.Value = Format(MIN_FRT_QTY.Value, "#,##0.000 ;-#,##0.000")
End Sub
Private Sub OT_QTY_Change()
OT_QTY.Value = Format(OT_QTY.Value, "#,##0.000 ;-#,##0.000")
End Sub
Private Sub BL_DATE_Change()
BL_DATE.Value = Format(BL_DATE.Value, "dd-mmm-yy")
End Sub
Private Sub COD_DATE_Change()
COD_DATE.Value = Format(COD_DATE.Value, "dd-mmm-yy")
 End Sub
Private Sub LP_INSP_SHARING_Change()
LP_INSP_SHARING.Value = Format(LP_INSP_SHARING.Value, "0%")
 End Sub
Private Sub DP_INSP_SHARING_Change()
DP_INSP_SHARING.Value = Format(DP_INSP_SHARING.Value, "0%")
 End Sub
Private Sub TOLERANCE_Change()
TOLERANCE.Value = Format(TOLERANCE.Value, "0%")
 End Sub
 
Private Sub UserForm_Initialize()
Dim iRow As Long
Dim iRow1 As Long
Dim Wsh As Worksheet
Dim Wsh1 As Worksheet
Dim SEARCH_I As String
Dim MONTH As String
Dim REF As String
Dim OIC As String
Dim VSL As String
Dim GRADE As String
Dim LP As String
Dim DP As String
Dim SUPPLIER As String
Dim TERM_P As String
Dim CT_QTY As String
Dim TOLERANCE As String
Dim CT_DATES_TERM As String
Dim CT_DATES As String
Dim PRICING_P As String
Dim PMT_P As String
Dim PREM_P As String
Dim OSP_P As String
Dim INV_QTY_P As String
Dim LP_INSP As String
Dim LP_INSP_SHARING As String
Dim LP_AGT As String
Dim LP_AGT_CATEGORY As String
Dim RCVRS As String
Dim TERM_S As String
Dim REQ_MIN_QTY As String
Dim REQ_MAX_QTY As String
Dim PRICING_S As String
Dim PMT_S As String
Dim PREM_S As String
Dim OSP_S As String
Dim INV_QTY_S As String
Dim DP_INSP As String
Dim DP_INSP_SHARING As String
Dim DP_AGT As String
Dim DP_AGT_CATEGORY As String
Dim MIN_FRT_QTY As String
Dim WS As String
Dim BL_DATE As String
Dim BL_NET_QTY As String
Dim BL_GROSS_QTY As Long
Dim COD_DATE As String
Dim OT_QTY As String
Dim ROW_NR As String
 
Set Wsh = Worksheets("RECAP")
Set Wsh1 = Worksheets("PRICING FINAL")
 
SEARCH_I = "2015CT001"
 
'find first empty row in database
iRow = Wsh.Cells.Find(What:=SEARCH_I, SearchOrder:=xlRows, _
    SEARCHDIRECTION:=xlPrevious, LookIn:=xlValues).Row
iRow1 = Wsh1.Cells.Find(What:=SEARCH_I, SearchOrder:=xlRows, _
    SEARCHDIRECTION:=xlPrevious, LookIn:=xlValues).Row
 
'copy the data to the database
'use protect and unprotect lines,
'     with your password
'     if worksheet is protected
REF = Wsh.Cells(iRow, "C").Value
MONTH = Wsh.Cells(iRow, "A").Value
OIC = Wsh.Cells(iRow, "D").Value
GRADE = Wsh.Cells(iRow, "F").Value
VSL = Wsh.Cells(iRow, "E").Value
LP = Wsh.Cells(iRow, "G").Value
DP = Wsh.Cells(iRow, "Y").Value
SUPPLIER = Wsh.Cells(iRow, "L").Value
TERM_P = Wsh.Cells(iRow, "M").Value
CT_QTY = Wsh.Cells(iRow, "I").Value
TOLERANCE = Wsh.Cells(iRow, "J").Value
CT_DATES_TERM = Wsh.Cells(iRow, "N").Value
CT_DATES = Wsh.Cells(iRow, "O").Value
PRICING_P = Wsh1.Cells(iRow1, "O").Value
PMT_P = Wsh1.Cells(iRow1, "P").Value
PREM_P = Wsh1.Cells(iRow1, "S").Value
OSP_P = Wsh1.Cells(iRow1, "R").Value
INV_QTY_P = Wsh1.Cells(iRow1, "M").Value
LP_INSP = Wsh.Cells(iRow, "R").Value
LP_INSP_SHARING = Wsh.Cells(iRow, "S").Value
LP_AGT = Wsh.Cells(iRow, "U").Value
LP_AGT_CATEGORY = Wsh.Cells(iRow, "V").Value
RCVRS = Wsh.Cells(iRow, "W").Value
TERMS_S = Wsh.Cells(iRow, "X").Value
REQ_MIN_QTY = Wsh.Cells(iRow, "Z").Value
REQ_MAX_QTY = Wsh.Cells(iRow, "AA").Value
PRICING_S = Wsh1.Cells(iRow1, "AG").Value
PMT_S = Wsh1.Cells(iRow1, "AH").Value
PREM_S = Wsh1.Cells(iRow1, "AK").Value
OSP_S = Wsh1.Cells(iRow1, "AJ").Value
INV_QTY_S = Wsh1.Cells(iRow1, "AE").Value
DP_INSP = Wsh.Cells(iRow, "AD").Value
DP_INSP_SHARING = Wsh.Cells(iRow, "AE").Value
DP_AGT = Wsh.Cells(iRow, "AG").Value
DP_AGT_CATEGORY = Wsh.Cells(iRow, "AH").Value
MIN_FRT_QTY = Wsh1.Cells(iRow1, "BB").Value
WS = Wsh1.Cells(iRow1, "BC").Value
BL_DATE = Wsh.Cells(iRow, "AI").Value
BL_NET_QTY = Wsh.Cells(iRow, "AL").Value
BL_GROSS_QTY = Wsh.Cells(iRow, "AK").Value
COD_DATE = Wsh.Cells(iRow, "AJ").Value
OT_QTY = Wsh.Cells(iRow, "AM").Value
ROW_NR = Right(REF, 3)
 
'  .Protect Password:="password"
Me.REF.Value = REF
Me.MONTH.Value = MONTH
Me.VSL.Value = VSL
Me.OIC.Value = OIC
Me.GRADE.Value = GRADE
Me.LP.Value = LP
Me.DP.Value = DP
Me.SUPPLIER.Value = SUPPLIER
Me.TERM_P.Value = TERM_P
Me.CT_QTY.Value = CT_QTY
Me.TOLERANCE.Value = TOLERANCE
Me.CT_DATES_TERM.Value = CT_DATES_TERM
Me.CT_DATES.Value = CT_DATES
Me.PRICING_P.Value = PRICING_P
Me.PMT_P.Value = PMT_P
Me.PREM_P.Value = PREM_P
Me.OSP_P.Value = OSP_P
Me.INV_QTY_P.Value = INV_QTY_P
Me.LP_INSP.Value = LP_INSP
Me.LP_INSP_SHARING.Value = LP_INSP_SHARING
Me.LP_AGT.Value = LP_AGT
Me.LP_AGT_CATEGORY.Value = LP_AGT_CATEGORY
Me.RCVRS.Value = RCVRS
Me.TERMS_S.Value = TERMS_S
Me.REQ_MIN_QTY.Value = REQ_MIN_QTY
Me.REQ_MAX_QTY.Value = REQ_MAX_QTY
Me.PRICING_S.Value = PRICING_S
Me.PMT_S.Value = PMT_S
Me.PREM_S.Value = PREM_S
Me.OSP_S.Value = OSP_S
Me.INV_QTY_S.Value = INV_QTY_S
Me.DP_INSP.Value = DP_INSP
Me.DP_INSP_SHARING.Value = DP_INSP_SHARING
Me.DP_AGT.Value = DP_AGT
Me.DP_AGT_CATEGORY.Value = DP_AGT_CATEGORY
Me.MIN_FRT_QTY.Value = MIN_FRT_QTY
Me.WS.Value = WS
Me.BL_DATE.Value = BL_DATE
Me.BL_NET_QTY.Value = BL_NET_QTY
Me.BL_GROSS_QTY.Value = BL_GROSS_QTY
Me.COD_DATE.Value = COD_DATE
Me.OT_QTY.Value = OT_QTY
Me.ROW_NR.Value = ROW_NR
'clear the data
 
 
End Sub

j'ai trouve un code pour un boutton "next", le probleme est que l'exemple est plus "simple" que mon code et que moi j'ai 2 differentes feuilles pas seulement une seule....et donc je n'arrive pas du tout a l'adapter a mon cas.....et c bien dommage car il etait exactement pour faire ce que je veux

le voice

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
Private Sub CommandButton2_Click()
 
Dim r As Long
 
If IsNumeric(RowNumber.Text) Then
    r = CLng(RowNumber.Text)
 
    r = r ? 1
    If r > 1 And r <= LastRow Then
        RowNumber.Text = FormatNumber(r, 0)
 
    End If
 
End If
 
End Sub

pour la recherché/tri par mois j'avais pense me base sur la procedure "ref change()" mais il ne me donne que la derniere reference concernee par ce mois la

voice le code que j'avais pense

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
 
Private Sub MONTH_Change()
Dim iRow As Long
Dim iRow1 As Long
Dim Wsh As Worksheet
Dim Wsh1 As Worksheet
Dim SEARCH_I As String
Dim MONTH As String
Dim REF As String
Dim OIC As String
Dim VSL As String
Dim GRADE As String
Dim LP As String
Dim DP As String
Dim SUPPLIER As String
Dim TERM_P As String
Dim CT_QTY As String
Dim TOLERANCE As String
Dim CT_DATES_TERM As String
Dim CT_DATES As String
Dim PRICING_P As String
Dim PMT_P As String
Dim PREM_P As String
Dim OSP_P As String
Dim INV_QTY_P As String
Dim LP_INSP As String
Dim LP_INSP_SHARING As String
Dim LP_AGT As String
Dim LP_AGT_CATEGORY As String
Dim RCVRS As String
Dim TERM_S As String
Dim REQ_MIN_QTY As String
Dim REQ_MAX_QTY As String
Dim PRICING_S As String
Dim PMT_S As String
Dim PREM_S As String
Dim OSP_S As String
Dim INV_QTY_S As String
Dim DP_INSP As String
Dim DP_INSP_SHARING As String
Dim DP_AGT As String
Dim DP_AGT_CATEGORY As String
Dim MIN_FRT_QTY As String
Dim WS As String
Dim BL_DATE As String
Dim BL_NET_QTY As String
Dim BL_GROSS_QTY As String
Dim COD_DATE As String
Dim OT_QTY As String
Dim ROW_NR As String
 
Set Wsh = Worksheets("RECAP")
Set Wsh1 = Worksheets("PRICING FINAL")
 
SEARCH_I = Me.MONTH.Value
 
'find first empty row in database
iRow = Wsh.Cells.Find(What:=SEARCH_I, SearchOrder:=xlRows, _
    SEARCHDIRECTION:=xlPrevious, LookIn:=xlValues).Row
iRow1 = Wsh1.Cells.Find(What:=SEARCH_I, SearchOrder:=xlRows, _
    SEARCHDIRECTION:=xlPrevious, LookIn:=xlValues).Row
 
'copy the data to the database
'use protect and unprotect lines,
'     with your password
'     if worksheet is protected
MONTH = Me.MONTH.Value
REF= Wsh.Cells(iRow, "C").Value
OIC = Wsh.Cells(iRow, "D").Value
GRADE = Wsh.Cells(iRow, "F").Value
VSL = Wsh.Cells(iRow, "E").Value
LP = Wsh.Cells(iRow, "G").Value
DP = Wsh.Cells(iRow, "Y").Value
SUPPLIER = Wsh.Cells(iRow, "L").Value
TERM_P = Wsh.Cells(iRow, "M").Value
CT_QTY = Wsh.Cells(iRow, "I").Value
TOLERANCE = Wsh.Cells(iRow, "J").Value
CT_DATES_TERM = Wsh.Cells(iRow, "N").Value
CT_DATES = Wsh.Cells(iRow, "O").Value
PRICING_P = Wsh1.Cells(iRow1, "O").Value
PMT_P = Wsh1.Cells(iRow1, "P").Value
PREM_P = Wsh1.Cells(iRow1, "S").Value
OSP_P = Wsh1.Cells(iRow1, "R").Value
INV_QTY_P = Wsh1.Cells(iRow1, "M").Value
LP_INSP = Wsh.Cells(iRow, "R").Value
LP_INSP_SHARING = Wsh.Cells(iRow, "S").Value
LP_AGT = Wsh.Cells(iRow, "U").Value
LP_AGT_CATEGORY = Wsh.Cells(iRow, "V").Value
RCVRS = Wsh.Cells(iRow, "W").Value
TERMS_S = Wsh.Cells(iRow, "X").Value
REQ_MIN_QTY = Wsh.Cells(iRow, "Z").Value
REQ_MAX_QTY = Wsh.Cells(iRow, "AA").Value
PRICING_S = Wsh1.Cells(iRow1, "AG").Value
PMT_S = Wsh1.Cells(iRow1, "AH").Value
PREM_S = Wsh1.Cells(iRow1, "AK").Value
OSP_S = Wsh1.Cells(iRow1, "AJ").Value
INV_QTY_S = Wsh1.Cells(iRow1, "AE").Value
DP_INSP = Wsh.Cells(iRow, "AD").Value
DP_INSP_SHARING = Wsh.Cells(iRow, "AE").Value
DP_AGT = Wsh.Cells(iRow, "AG").Value
DP_AGT_CATEGORY = Wsh.Cells(iRow, "AH").Value
MIN_FRT_QTY = Wsh1.Cells(iRow1, "BB").Value
WS = Wsh1.Cells(iRow1, "BC").Value
BL_DATE = Wsh.Cells(iRow, "AI").Value
BL_NET_QTY = Wsh.Cells(iRow, "AL").Value
BL_GROSS_QTY = Wsh.Cells(iRow, "AK").Value
COD_DATE = Wsh.Cells(iRow, "AJ").Value
OT_QTY = Wsh.Cells(iRow, "AM").Value
ROW_NR = Right(Me.REF.Value, 3)
 
'  .Protect Password:="password"
Me.REF.Value = REF
Me.MONTH.Value = MONTH
Me.VSL.Value = VSL
Me.OIC.Value = OIC
Me.GRADE.Value = GRADE
Me.LP.Value = LP
Me.DP.Value = DP
Me.SUPPLIER.Value = SUPPLIER
Me.TERM_P.Value = TERM_P
Me.CT_QTY.Value = CT_QTY
Me.TOLERANCE.Value = TOLERANCE
Me.CT_DATES_TERM.Value = CT_DATES_TERM
Me.CT_DATES.Value = CT_DATES
Me.PRICING_P.Value = PRICING_P
Me.PMT_P.Value = PMT_P
Me.PREM_P.Value = PREM_P
Me.OSP_P.Value = OSP_P
Me.INV_QTY_P.Value = INV_QTY_P
Me.LP_INSP.Value = LP_INSP
Me.LP_INSP_SHARING.Value = LP_INSP_SHARING
Me.LP_AGT.Value = LP_AGT
Me.LP_AGT_CATEGORY.Value = LP_AGT_CATEGORY
Me.RCVRS.Value = RCVRS
Me.TERMS_S.Value = TERMS_S
Me.REQ_MIN_QTY.Value = REQ_MIN_QTY
Me.REQ_MAX_QTY.Value = REQ_MAX_QTY
Me.PRICING_S.Value = PRICING_S
Me.PMT_S.Value = PMT_S
Me.PREM_S.Value = PREM_S
Me.OSP_S.Value = OSP_S
Me.INV_QTY_S.Value = INV_QTY_S
Me.DP_INSP.Value = DP_INSP
Me.DP_INSP_SHARING.Value = DP_INSP_SHARING
Me.DP_AGT.Value = DP_AGT
Me.DP_AGT_CATEGORY.Value = DP_AGT_CATEGORY
Me.MIN_FRT_QTY.Value = MIN_FRT_QTY
Me.WS.Value = WS
Me.BL_DATE.Value = BL_DATE
Me.BL_NET_QTY.Value = BL_NET_QTY
Me.BL_GROSS_QTY.Value = BL_GROSS_QTY
Me.COD_DATE.Value = COD_DATE
Me.OT_QTY.Value = OT_QTY
Me.ROW_NR.Value = ROW_NR
'clear the data
 
End Sub

**pasdechances** · 30/09/2015, 11h01

je vois, ^^' je vais t’embêter encore, dans tout se "raffut" quel partie doit tu modifier ou adapter ? met la en avant et utilise les balises [CODE][/CODE]

PS : je n'en doute pas une seconde ton code était surement disponible dans ton fichier mais pour des raison évidente de sécurité je ne télécharge que très rarement les fichiers joint.

REDIT : hmmm, donc tu dit que sa correspond exactement a ton besoin ?
et que ça ne marche pas car tu as plusieurs feuilles ?
bon en supposant que la valeur que tu recherche est "r"
alors : il faut que tu dise que dans "r" tu aura la valeur d'une cellule qui peut venir, soit de la feuil1, soit de la feuil2.
de ce fait il faut que tu le dise de cette façon : r = RowNumber
bon maintenant on en vien au corp :

Code :

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

1
2
r = clng(r)
if r > 1 and r <= lastrow then r = FormatNumber(r, 0)

**pasdechances** · 30/09/2015, 11h14

Ah et je suis désolé, mais je suis tout bonnement incapable de lire les paver de code que tu post ^^'.
mis à par que j'ai pu constater, qu'il y avait pas mal de répétition pour rien, mais au pire c'est pas grave, ton cote est compact pas aéré et pour une personne qui débute tu doit bien t’embêter pour te relire.
cela dit, si tu a la forme algorithmique(je t'ai mis un exemple en bas) de la fonction que tu veu travailler je pense que la traduction pourra se faire plus rapidement et tu apprendra en plus a utiliser une méthode viable et en plus en cas de problème on te comprendra mieux =D.

EX :

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
initialisation de x
 
x est égale à 1
'les condition sont présenter comme ça : 
Si x est inférieur a 1 alors
    x prendra la valeur de la cellule "A1" de la feuille 1
Si non 
    x est égale à 2
fin Si
 
'les boucle se présente de cette façon : 
 
tant que x est inférieur a 10 alors
 
    x augmente de 1 
 
Fin tant que

en expliquant ton besoin avec ces element tu vera que la compréhension sera amélioré

**Mariec_06** · 30/09/2015, 13h24

oui je me rends bien compte que le code n'est pas tres orthodoxes, un collegue l'a commence pour moi (la commande "add") mais a malheureusement a du quitter la boite juste après et j'ai du continuer toute seule n'ayant absolument aucune notion de VBA et c'est bien pour ca que malgre toutes les ressources du web je n'arrive absolument pas a les adapter

c'est bien ce que je pensais que je devrais le recommencer entierement a zero dans les regles de l'art et je reviendrai peut etre a ce moment la

desolee de vous avoir fait perdre votre temps et merci beaucoup en tout cas

aide code VBA - User Form

Macros et VBA Excel

Discussions similaires

Partager

Partager