[XL-2003] copier un menu déroulant existant [Résolu]

[hobine]

Bonjour,
J'aimerai savoir comment copier un menu déroulant existant d'un fichier A pour un autre fichier ( fichier B) en vba?
En effet, j'ai un programme qui me copie déjà les base de données d'une feuille d'un fichier qui contient les listes déroulantes. Seulement je n'arrive pas à copier aussi sa liste déroulante associée. Autrement dit, je veux maintenir le même type de format de mon fichier initial sur mon fichier créé

Cordialement
A

[Golonne]

Bonjour,

Il faut utiliser la propriété Validation de l'objet Range. (F1 ! ) et sa propriété InCellDropDown.

Si tu veux par exemple mettre en A1 ta liste déroulante qui porte sur les choix des cellules E1 à E4, le code sera le suivant :

Code :

1
2
3
4
5
 With Range("A1").Validation
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=$E$1:$E$4"
        .InCellDropdown = True
 End With

Cordialement,

Guillaume.

[hobine]

Merci Golonne,
pour ta réponse, mais cela ne répond pas exactement à mes besoins.
J'ai une macro qui copie les valeurs se trouvant dans un fichier. ces valeurs sont collées dans un fichier. Mais seulement mon premier fichier contient aussi des listes (menus) déroulantes. Ma question est de savoir comment copier (ou récupérer) aussi ces listes déroulantes pour le second fichier?
Tu trouveras un bout de mon programme ci-dessus.

Cordialement

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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
Sub CopierBDD(chemin As String, fichier As String)
 
 
Set xlBook = Workbooks.Open(fichier)
Set xlListes = xlBook.Sheets("Listes")
Set xlBDD = xlBook.Sheets("BdD")
 
 
Dim inCalculationMode As Integer
Application.ScreenUpdating = False
inCalculationMode = Application.Calculation
Application.Calculation = xlCalculationManual
 
 
Set Wbk = Workbooks.Open(fichier)
 
With Wbk.Worksheets("Listes")
' ici sont créées les listes déroulantes
 
    Set plage = .Range("A1:DV" & .Range("A65536").End(xlUp).Row)
End With
tbl = plage.Value
jcase = UBound(tbl, 1)
kcase = UBound(tbl, 2)
 
 
Set Sh = Wbk.Worksheets("Listes")
With ThisWorkbook.Worksheets("FeuilleCachée")
    For i = 1 To jcase
        For j = 1 To kcase
            .Cells(i, j).Value = Sh.Cells(i, j).Value
            .Cells(i, j).Interior.ColorIndex = Sh.Cells(i, j).Interior.ColorIndex
            .Cells(i, j).Font.ColorIndex = Sh.Cells(i, j).Font.ColorIndex
        Next j
    Next i
End With
 
 
Wbk.Close False
Set Wbk = Nothing
 
Application.Calculation = inCalculationMode
Application.ScreenUpdating = True
 
 
 Application.ThisWorkbook.Worksheets("FeuilleCachée").Visible = False
 
Sheets.Add
ActiveSheet.Name = "BdD"
' ici sont validées les listes déroulantes créées dans la feuille Listes
 
Set Wbk = Workbooks.Open(fichier)
With Wbk.Worksheets("BdD")
    Set plage = .Range("A1:DV" & .Range("A65536").End(xlUp).Row)
End With
tbl = plage.Value
jcase = UBound(tbl, 1)
kcase = UBound(tbl, 2)
 
 
Set Sh = Wbk.Worksheets("BdD")
With ThisWorkbook.Worksheets("BdD")
'    For i = 1 To jcase
    For i = 1 To 2
'        For j = 1 To kcase
        For j = 1 To 2
            .Cells(i, j).Value = Sh.Cells(i, j).Value
            .Cells(i, j).Interior.ColorIndex = Sh.Cells(i, j).Interior.ColorIndex
            .Cells(i, j).Font.ColorIndex = Sh.Cells(i, j).Font.ColorIndex
        Next j
    Next i
End With
 'Ici la macro copie les valeurs mais sans les listes validées de son fichier d'origine, comment copier aussi cette liste et sa validation précédente?
 
Wbk.Close False
Set Wbk = Nothing
 
Application.Calculation = inCalculationMode
Application.ScreenUpdating = True
 
 
 Application.ThisWorkbook.Worksheets("BdD").Visible = False
 
' BdD_piece
Sheets.Add
ActiveSheet.Name = "BdD_piece"
 
Set Wbk = Workbooks.Open(fichier)
With Wbk.Worksheets("BdD")
    Set plage = .Range("A1:FZ" & .Range("A3").End(xlUp).Row)
End With
tbl = plage.Value
jcase = UBound(tbl, 1)
kcase = UBound(tbl, 2)
 
MsgBox jcase
MsgBox kcase
 
Set Sh = Wbk.Worksheets("BdD")
With ThisWorkbook.Worksheets("BdD_piece")
    For i = 1 To jcase
        For j = 1 To kcase
            .Cells(i, j).Value = Sh.Cells(i, j).Value
            .Cells(i, j).Interior.ColorIndex = Sh.Cells(i, j).Interior.ColorIndex
            .Cells(i, j).Font.ColorIndex = Sh.Cells(i, j).Font.ColorIndex
 
'            .Cells(i, j).Underline = Sh.Cells(i, j).Underline
            'ajouter qu'il faut copier la largeur des cellules
        Next j
    Next i
End With
 
 
 
Wbk.Close False
Set Wbk = Nothing
 
Application.Calculation = inCalculationMode
Application.ScreenUpdating = True
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
UsfChoix.Hide
 
 
 
 
End Sub

[Golonne]

Bonjour,

Ca mérite un éclaircissement en effet. Je pensais que tes listes déroulantes étaient dans ta feuille de calcul (et rien dans ton post initial ne laissait présager le contraire). Or il y a cette ligne :

Code :

UsfChoix.Hide

Tu utilises un UserForm ? Les listes dont tu parles apparaissent dans ce UserForm (ComboBox ou ListBox) ?

Cordialement,

Guillaume

[hobine]

Oui, j'utilise un userform, mais les listes dont je parle sont utilisées dans feuille initiale pour faciliter le remplissage des cellules de cette feuille. Etant donné que je copie ces données, je veux aussi copier cette liste déroulante dans le fichier B pour me faciliter aussi le remplissage de ma feuille. Je ne sais pas si le problème est bien posé?
Je suis entrain d'essayer un truc mais cela ne fonctionne pas (voir code ci-dessous)
avec ce code, je récupère toutes les valeurs y compris les listes déroulantes? si oui, supposons que sheets("AA") à 3 colonnes contenant chacune une liste. Je veux un code permettant de réécrire (stocker) chacune de listes et son contenu quelque part dans le workbooks("b.xls").sheets(1) afin de l'utiliser dans une autre feuille du même dossier plu tard.

est possible? si oui, comment faire? je pense que cela peut être une alternative à mon problème.

Cordialement
Aubin

Code :

1
2
3
ws_Template.Copy Before:=xlBookFile.Sheets(iNbrSheet)
 
ThisWorkbook.Sheets("AA").Copy Before:=Workbooks("B.xls").Sheets(1)

[Golonne]

Ok je vois maintenant. Pour reprendre ton exemple :

Classeur 1.FeuilleAA : tes données sur 3 colonnes A,B,C. La colonne A alimente une liste de choix, B idem, C idem. Sur le même classeur une autre feuille"BB" avec 3 cellules qui prennent la valeur de ces trois listes, respectivement.

Tu veux conserver les données de ta feuille AA dans un autre classeur (Classeur2) qui comporte une feuilleBB dans lequel on retrouve tes 3 cellules avec la même liste de choix proposés dans le classeur 1.

J'ai tout bon ?

Guillaume.

[hobine]

Parfaitement bon, mais cela se doit d'être automatisé cette routine. pas de manuelle.
"Tu veux conserver les données de ta feuille AA dans un autre classeur (Classeur2) qui comporte une feuilleBB dans lequel on retrouve tes 3 cellules avec la même liste de choix proposés dans le classeur 1. "
oui et par la suite générer une autre feuille dans le classeur 2 i.e feuille CC (dans classeur2) avec la possibilité également d'utiliser la liste déroulante issue de la feuille AA

[Golonne]

Bonjour Hobine,

J'ai du boulot aujourd'hui alors je risque de ne pas pouvoir te répondre de suite. Cependant, regarde ma première réponse, je pense que la solution est là. Je te renvoie un classeur de test ce midi

A plus tard.

Guillaume.

[hobine]

Bonjour Guillaume,

Je mets en pièce jointe un exemple de fichiers que j'utilise.
1. Fichier "test2" contient les 2 onglets BdD et listes.
l'onglet BdD contient les listes deroulantes.
2. 20120117PdS contient au depart aussi 2 onglets et des macros avec bug à l'interieur.

Travail souhaité:
- copier uniquement les valeurs de l'onglet BdD en generant un onglet dans le classeur 20120117PdS
- Copier l'onglet "listes" en generant une nouvelle feuille dans le classeur 20120117PdS
- generer une nouvelle feuille dans le classeur 20120117PdS où
a) copiera l'entête et le format y compris les bordures de l'onglet BdD du classeur "test2"
b) écrire un code permettant à l'utilisateur dès qu'il veut remplir ou saisir les données sur une ligne de cette feuille que les cellules puissent lui proposer les mêmes listes déroulantes de l'onglet "BdD" du fichier "test2".

ma macro contient les bugs , se trouve dans le fichier 20120117PdS .
Pourrez vous s'il vous plaît jeter un coup d'oeil dessus et l’améliorer?

Cordialement
Aubin

[hobine]

oublie le fichier test en PJ