Afficher image si presente selon selection dans ListBox ne fonctionne pas

**svetlan** · 07/10/2015, 16h03

Bonjour,

J'ai un controle "image" comme suit :

Code :

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

1
2
3
4
5
6
7
8
9
10
Private Sub Imag_Click()
 
If prode.ListIndex > -1 And fotto.Visible = True Then
    fotto.Picture = LoadPicture("")
    fot = Feuil1.Cells(Xprod, 10)
If fs.FileExists(fot) = True Then Imag.Picture = LoadPicture(fot) Else: Imag.Picture = LoadPicture("")
 
    End If
End If
End Sub

qui devrait m'afficher une image si elle presente en selectionnant une ligne dans une ListBox comme suit .

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 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)
    End If
 
    fotto.Visible = True
End If
End Sub

Mais l'image n'apparait pas et elle bien presente, une aide serait bien venue

**patricktoulon** · 08/10/2015, 14h47

bonjour
a quel moment tu instancie l'object "Scripting" "fs" je le vois dans ton code
tel quel il est a false forcement puisque indefinie

copier coller n'a pas que du bon hein !!!

**svetlan** · 08/10/2015, 19h18

Envoyé par patricktoulon

....

copier coller n'a pas que du bon hein !!!

Bonsoir,
Merci, effectivement le coller n'a pas fonctionné et je ne trouve pas l'erreur, d'ou ma requete.

**patricktoulon** · 08/10/2015, 23h14

re
ben non tu peux pas savoir il manque une bonne partie du code tel quel

si tu n'a que ca comme code je te suggere de faire une recherche sur scripting file system

**SfJ5Rpw8** · 09/10/2015, 11h39

Bonjour,

tiens ajoute des messagebox dans ton code pour en savoir plus :

lignes 9,10 et 14,15

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
 
 
(...)
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)
     else
         MsgBox "Fichier inexistant : " & fot
    End If
 
    fotto.Visible = True
else
   MsgBox "Fotto visible est Faux !!! "
 
End If
(...)

**svetlan** · 12/10/2015, 12h56

Bonjour,
Merci à tous pour tenter de m'aider , ce brouillard est trop épais pour moi, vous m'en excuserez, comme je le répète souvent, je reprends un travail que je ne connaît pas et c'est très diffcifile, on ne s'improvise pas dans ce domaine, j'en suis conscient.

Pour résumer :

L'dée était de reprendre ce bout de code qui fonctionne très bien et qui m'affiche la photo en question :

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
Option Explicit
 
Private Sub CommandButton2_Click()
change = False
Unload Me
End Sub
 
 
Private Sub Imag_Click()
 
End Sub
 
Private Sub UserForm_Activate()
Dim fot
TextBox1 = Feuil1.Cells(lign, 1)
TextBox2 = Feuil1.Cells(lign, 2)
mini = Feuil1.Cells(lign, 11)
fot = Feuil1.Cells(lign, 10)
If fs.FileExists(fot) = True Then Imag.Picture = LoadPicture(fot) Else: Imag.Picture = LoadPicture("")
End Sub

Et de tenter d'appliquer cet affichage dans mon controle "Imag" (Ligne 566) :

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
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
 
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
        End If
    Next t
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 comand_Click()
TextBox1 = comand
End Sub
 
 
Private Sub CommandButton1_Click()
 '///////////////////////////////////////////////////////////////////////////////////////////
Dim mdp As String
mdp = InputBox("Password please")
 
If mdp = "22011967" Then
    'Déprotection de la feuille ici
Else
     MsgBox "Wrong" _
            & " Password.", _
            vbExclamation, _
            "You won't have access"
    Exit Sub
End If
 '///////////////////////////////////////////////////////////////////////////////////////////
Dim fin5 As Long, fin2 As Long
Dim repons
Dim prodd As Long
Dim placc
 
prodd = Xprod
 
If prodd = 0 Then
    averti6
    Exit Sub
End If
 
If IsDate(dat) = False Then
    averti4
    Exit Sub
End If
 
If adrs = "" Then
    averti2
    Exit Sub
End If
 
If Val(nbb) = 0 Then
    averti3
    Exit Sub
End If
 
'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)
    'End If
 
    If repons = 7 Then
        Exit Sub
   ' End If
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)
End If
 
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 CommandButton14_Click()
Dim a, b, c, d, e, f
 
a = Application.GetSaveAsFilename("")
If a = False Or a = "" Then
    Exit Sub
End If
 
b = Feuil1.Name
c = Feuil2.Name
d = Feuil3.Name
e = Feuil5.Name
f = Feuil7.Name
 
If Right(a, 3) <> "xls" Then
    a = a & ".xls"
End If
 
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 ty
End If
 
If MultiPage1.Value = 0 Then
    If TextBox1 = "" Then
        UserForm1.Show
        Exit Sub
    End If
 
    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") = "Item moving: " + intil
 
For x = 2 To finf2
    If Feuil2.Cells(x, 2) = prod Then
        For d = 1 To 4
            If d = 4 Then
                p = 1
            End If
 
            Feuil4.Cells(y, d + p) = Feuil2.Cells(x, d)
        Next d
 
        Feuil4.Cells(y, 2) = "In": y = y + 1
    End If
Next x
 
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 d
 
        Feuil4.Cells(y, 2) = "Out"
        y = y + 1
    End If
Next x
 
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 d
 
        Feuil4.Cells(y, 2) = "Moving": y = y + 1
    End If
Next x
 
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
Static Ordre As Long
If Ordre = xlAscending Then Ordre = xlDescending Else Ordre = xlAscending
a = Replace(Feuil1.Range("a1").End(xlToRight).Address, "1", "")
Feuil1.Range("a1:" & a & finf1 - 1).Sort Key1:=Feuil1.Range("a1"), Order1:=Ordre, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
dico1
lifour
End Sub
 
 
'**********************************************
 
'**********************************************
 
Private Sub CommandButton18_Click()
Dim a
  Static Ordre As Long
    If Ordre = xlAscending Then Ordre = xlDescending Else Ordre = xlAscending
a = Replace(Feuil1.Range("a1").End(xlToRight).Address, "1", "")
Feuil1.Range("a1:" & a & finf1 - 1).Sort Key1:=Feuil1.Range("b1"), Order1:=Ordre, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
dico1
lifour
End Sub
 
 
Private Sub CommandButton19_Click()
Dim a
  Static Ordre As Long
    If Ordre = xlAscending Then Ordre = xlDescending Else Ordre = xlAscending
a = Replace(Feuil1.Range("a1").End(xlToRight).Address, "1", "")
Feuil1.Range("a1:" & a & finf1 - 1).Sort Key1:=Feuil1.Range("c1"), Order1:=Ordre, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
dico1
lifour
End Sub
 
 
Private Sub CommandButton2_Click()
 '///////////////////////////////////////////////////////////////////////////////////////////
Dim mdp As String
mdp = InputBox("Password please")
 
If mdp = "22011967" Then
    'Déprotection de la feuille ici
Else
     MsgBox "Wrong" _
            & " Password.", _
            vbExclamation, _
            "You won't have access"
    Exit Sub
End If
 '///////////////////////////////////////////////////////////////////////////////////////////
Dim fin5 As Long, fin2 As Long
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
End If
 
If plac.ListIndex = -1 Then
    averti1
    Exit Sub
End If
 
If Val(nbb) = 0 Then
    averti3
    Exit Sub
End If
 
If adrs = "" Then
    averti2
    Exit Sub
End If
 
If adrs = plac Then
    averti5
    Exit Sub
End If
 
If IsDate(dat) = False Then
    averti4
    Exit Sub
End If
 
placc = xplac
If Feuil5.Cells(placc, 4) < Val(nbb) Then
     MsgBox "You can't" _
            & " do that ! Check data entered...!", _
            vbExclamation, _
            "You won't have access"
 
    Exit Sub
End If
 
If placc > -1 Then
    Feuil5.Cells(placc, 4) = Feuil5.Cells(placc, 4) - Val(nbb)
End If
 
If Feuil5.Cells(placc, 4) = 0 Then
    Feuil5.Rows(placc).Delete
End If
 
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 CommandButton20_Click()
 
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
End If
 
If plac.ListIndex = -1 Then
    averti1
    Exit Sub
End If
 
If adrs = "" Then
    averti2
    Exit Sub
End If
 
If adrs = plac Then
    averti5
    Exit Sub
End If
 
If Val(nbb) = 0 Then
    averti3
    Exit Sub
End If
 
If IsDate(dat) = False Then
    averti4
    Exit Sub
End If
 
'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)
    'End If
 
    If repons = 7 Then
        Exit Sub
    End If
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)
    End If
Else
    MsgBox ("Wrong demand... " & Chr(10) & "You can't, check your data")
    Exit Sub
End If
 
If Feuil5.Cells(g, 4) = 0 Then
    Feuil5.Rows(g).Delete
End If
 
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 ("You must remove all Item from the stock, before any other action")
    Exit Sub
End If
 
If Xprod = 0 Then
    MsgBox ("Select Item !")
    Exit Sub
End If
 
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
End If
 
For f = 2 To finf1
    Feuil1.Cells(f, 3) = Feuil1.Cells(f, 6)
Next f
 
With Feuil2
    derligne = .Range("a65536").End(xlUp).Row
 
    If derligne > 1 Then
        .Range("a2:E" & derligne).ClearContents
    End If
End With
 
With Feuil3
    derligne = .Range("a65536").End(xlUp).Row
 
    If derligne > 1 Then
        .Range("a2:E" & derligne).ClearContents
    End If
End With
 
With Feuil7
    derligne = .Range("a65536").End(xlUp).Row
 
    If derligne > 1 Then
        .Range("a2:E" & derligne).ClearContents
    End If
End With
 
With Feuil1
    derligne = .Range("a65536").End(xlUp).Row
 
    If derligne > 1 Then
        .Range("d2:E" & derligne).ClearContents
    End If
End With
 
TextBox1 = ""
End Sub
 
 
Private Sub dat_Change()
 
End Sub
 
Private Sub fotto_Click()
fotto.Visible = False
End Sub
 
 
Private Sub Imag_Click()
 
If prode.ListIndex > -1 And fotto.Visible = True Then
    fotto.Picture = LoadPicture("")
    fot = Feuil1.Cells(Xprod, 10)
If fs.FileExists(fot) = True Then Imag.Picture = LoadPicture(fot) Else: Imag.Picture = LoadPicture("")
 
    End If
End If
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
        End If
    Next t
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
        End If
    Next t
End If
 
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)
     Else
         MsgBox "Fichier inexistant : " & fot
    End If
 
    fotto.Visible = True
Else
   MsgBox "Fotto visible est Faux !!! "
 
End If
End Sub
 
 
Private Sub prode_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
lign = Xprod
 
If lign = 0 _
Or lign = 1 Then
    Exit Sub
End If
 
nouv1.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)
    End If
 
    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
End If
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 uniq_Click()
'Feuil6.Range("r1").Value = uniq
'End Sub
 
Private Sub UserForm_Activate()
If change = False Then
    change = True
    Exit Sub
End If
 
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 If
 
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
    End If
 
    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 If
End With
 
End Sub

Merci pour votre aide.

**svetlan** · 13/10/2015, 11h58

Bonjour,
alors après quelques test, la MsgBox "Fotto visible est Faux !!!" s'affiche.

toutefois elle existe bien, et quand je test avec l'autre userform en question je la vois bien.

**SfJ5Rpw8** · 13/10/2015, 12h04

bonjour,

pourquoi tu dit "elle existe bien" ..... le message ne te parle pas de son existence mais de sa visibilité ...!

à quoi te sert la propriété visible de on picture box ?

**svetlan** · 13/10/2015, 13h15

au risque de paraître ridicule, à l'affichage de ma PictureBox ? ce qui est le cas depuis le début.

**SfJ5Rpw8** · 13/10/2015, 14h14

et comment la gère tu ? je ne vois pas ou tu change sa valeur

**svetlan** · 13/10/2015, 14h58

Juste par la boilte de dialogue -(Propriété ?)qui se situe à gauche dans VBA

**SfJ5Rpw8** · 13/10/2015, 14h59

mais encore ??? que fais tu ... met cette propriété à True et teste ton code ..

Je ne sais pas ce que tu veux faire avec ... en attendant supprime le passage à false sur clic du contrôle fotto..