[XL-2007] Userform

Userform - combobox

bonsoir aux membres

j'ai un userform avec 9 combobox
les combo 7, 8 et 9 ne s'activent pas lorsque j'essaie le filtre...
que faudrait-il ajouter ou modifier comme paramètres ?

je voulais mettre le fichier en piece jointe mais il m'affiche toujours "fichier non valide"

merci pour votre réponse
nenemontserrat

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
Private Sub UserForm_Initialize()
 For c = 1 To 9
  ListeCol c
 Next c
 filtre
End Sub
Private Sub ComboBox1_DropButtonClick()
   ListeCol 1
End Sub
Private Sub ComboBox2_DropButtonClick()
   ListeCol 2
End Sub
Private Sub ComboBox3_DropButtonClick()
  ListeCol 3
End Sub
Private Sub ComboBox4_DropButtonClick()
  ListeCol 4
End Sub
Private Sub ComboBox5_DropButtonClick()
  ListeCol 5
End Sub
Private Sub ComboBox6_DropButtonClick()
  ListeCol 6
End Sub
Private Sub ComboBox7_DropButtonClick()
  ListeCol 7
End Sub
Private Sub ComboBox8_DropButtonClick()
  ListeCol 8
End Sub
Private Sub ComboBox9_DropButtonClick()
  ListeCol 9
End Sub
Sub ListeCol(noCol)
  Set MonDico = CreateObject("Scripting.Dictionary")
  For i = 1 To [bd].Rows.Count
     ok = True
     For n = 1 To [bd].Columns.Count
       If n <> noCol Then
         If Not Range("bd").Cells(i, n) Like Me("comboBox" & n) Then ok = False
       End If
     Next n
     If ok Then
       tmp = Range("BD").Cells(i, noCol)
       MonDico(tmp) = tmp
     End If
   Next i
   MonDico.Add "*", "*"
   temp = MonDico.items
   Call Tri(temp, LBound(temp), UBound(temp))
   Me("ComboBox" & noCol).List = temp
End Sub
Sub Tri(a, gauc, droi) ' Quick sort
ref = CStr(a((gauc + droi) \ 2))
g = gauc: d = droi
Do
Do While CStr(a(g)) < ref: g = g + 1: Loop
Do While ref < CStr(a(d)): d = d - 1: Loop
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call Tri(a, g, droi)
If gauc < d Then Call Tri(a, gauc, d)
End Sub
Private Sub ComboBox1_Change()
 filtre
End Sub
Private Sub ComboBox2_Change()
 filtre
End Sub
Private Sub ComboBox3_Change()
 filtre
End Sub
Private Sub ComboBox4_Change()
 filtre
End Sub
Private Sub ComboBox5_Change()
 filtre
End Sub
Private Sub ComboBox6_Change()
 filtre
End Sub
Private Sub ComboBox7Change()
 filtre
End Sub
Private Sub ComboBox8_Change()
 filtre
End Sub
Private Sub ComboBox9_Change()
 filtre
End Sub
Sub filtre()
   ligne = 0
   Me.ListBox1.Clear
   For i = 1 To [bd].Rows.Count
     ok = True
     For n = 1 To [bd].Columns.Count
         If Not Range("bd").Cells(i, n) Like Me("comboBox" & n) Then ok = False
     Next n
     If ok Then
       Me.ListBox1.AddItem
       For k = 1 To [bd].Columns.Count
         Me.ListBox1.List(ligne, k - 1) = Range("bd").Cells(i, k)
       Next k
       Me.ListBox1.List(ligne, 6) = Range("bd").Cells(i, k)
       On Error Resume Next
       tmp = Range("bd").Cells(i, k).Hyperlinks(1).Address
       If Err = 0 Then Me.ListBox1.List(ligne, 7) = tmp
       ligne = ligne + 1
      End If
   Next i
End Sub
Private Sub ListBox1_Click()
    On Error Resume Next
    Err = 0
    ActiveWorkbook.FollowHyperlink Address:=Me.ListBox1.Column(7), NewWindow:=True
    If Err <> 0 Then MsgBox "Erreur"
End Sub

je voulais mettre le fichier en piece jointe mais il m'affiche toujours "fichier non valide"

Bonsoir,
Il faut le ziper les xlsm ne sont pas accepté.

1 pièce(s) jointe(s)

Merci rdurupt
fichier en annexe
voila j'espère que c'est plus clair
bonne soirée
nenemontserrat

1 pièce(s) jointe(s)

Bonjour,
Ouvre ton fichier Excel ;
Fais [ALT]+[F11] ;
Fais [CTRL]+[G]
Colle Range("bd").Select puis entrer.
Regarde les cellules sélectionnées dans ton classeur et tu as la réponse.

La réponse

Merci bien rdurupt
je regarde demain au boulot
je n'arrive pas à ouvrir les fichiers
bonne soirée
nenemontserrat

Merci bien R Durupt
bonne soirée et la prochaine j'espère
nenemontserrat