Alimenter deux menus déroulants

**yieiyiei** · 10/10/2013, 11h52

Bonjour,

je souhaiterais alimenter deux menus déroulants avec des valeurs reprises sur deux feuilles annexe.
J'arrive à le faire pour un menu mais lorsque je double la ligne de code pour ajouter un deuxième menu ça ne fonctionne plus, je n'arrive pas à apter le code suivant pour que cela fonctionne, pouvez-vous regarder ?

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
Private Sub Workbook_Open()
    'Désactiver la mise à jour de l'écran
    Application.ScreenUpdating = False
    'Activer l'onglet "BDD_Profiles"
    Worksheets("BDD_Profiles").Activate
    Range("Profiles").Select
    'je double ici et il prend en compte uniquement cette feuille pour remplir le menu
    Worksheets("BDD_Visserie").Activate
    Range("Visserie").Select
 
    'Tant que la cellule "Profiles" n'est pas vide, ajouter son contenu aux listes Lst1 et Lst2
    Do While ActiveCell.Value <> ""
        Worksheets("Devis").Lst1.AddItem (ActiveCell.Value)
        Worksheets("Devis").Lst2.AddItem (ActiveCell.Value)
              'Sélectionner ligne suivante
        ActiveCell.Offset(1, 0).Select
    Loop
    'Mettre la valeur des listes à "" (soit vide) et réactiver le premier
    Worksheets("Devis").Lst1.Value = ""
    Worksheets("Devis").Lst2.Value = ""
    Worksheets("Devis").Activate
    'Réactiver la mise à jour de l'écran.
    Application.ScreenUpdating = True
End Sub

Merci.

**PMO2017** · 11/10/2013, 17h12

Bonjour,

Une piste avec le code suivant

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
Sub aa()
Dim S As Worksheet
Dim R As Range
Dim var
'--- Profilés ---
Set S = Sheets("BDD_Profiles")
Set R = S.Range("a2:a" & S.[a65536].End(xlUp).Row & "")
var = R
With Sheets("Devis").Lst1
  .List() = var
  .Value = ""
End With
'--- Visserie ---
Set S = Sheets("BDD_Visserie")
Set R = S.Range("a2:a" & S.[a65536].End(xlUp).Row & "")
var = R
With Sheets("Devis").Lst2
  .List() = var
  .Value = ""
End With
End Sub

Il faudra remplir la colonne "A" de BDD_Visserie car avec un seul élément cela ne fonctionne pas (au moins 2 sont nécessaires).