Titre du sujet : Re: liste de choix et recherche
par myDearFriend! le 21/06/2010 23:48:13
Bonsoir Nino63, le Forum,
Tu trouveras ci-joint une façon d'aborder ce type de problème.
J'espère que ça pourra te convenir...
Tout d'abord, j'ai déplacé tes listes A1:D6 sur une seconde feuille (qui pourra donc être cachée et comporter un nombre de lignes variant selon les besoins et sans avoir à déplacer tout le reste et donc, sans avoir à modifier le code VBA)
Ensuite, pas très à l'aise avec les listes de validation que je trouve très lourdes à gérer via VBA, j'ai opté pour un menu contextuel de cellule qui te permet de compléter une ligne complète en 2 clics de souris.
Dans la pièce jointe, j'ai utilisé le code VBA suivant :
DANS LE MODULE DE CODE DE LA FEUILLE 1
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub 'ne gère pas la sélection de plage
If Not Application.Intersect(Target, Range("A13:A65536")) Is Nothing Then
AffichListe
End If
End Sub
DANS UN MODULE DE CODE STANDARD (ex: Module1)
Option Explicit
'------------------------------------------------------------------------
' Auteur : Didier FOURGEOT (myDearFriend!) - www.mdf-xlpages.com
' Date : 21/06/2010
' Sujet : Menu en cascade
'------------------------------------------------------------------------
Sub AffichListe()
Dim CB As CommandBar
Dim M As CommandBarPopup, M1 As CommandBarPopup, M2 As CommandBarPopup, M3 As CommandBarButton
Dim TabTemp As Variant
Dim L As Long
'On mémorise la liste des données
With Sheets("Liste")
L = .Cells(.Rows.Count, 1).End(xlUp).Row
TabTemp = .Range(.Cells(2, 1), .Cells(L, 4)).Value
End With
'On crée une barre de menu temporaire
On Error Resume Next
Application.CommandBars("MenuD").Delete
On Error GoTo 0
Set CB = Application.CommandBars.Add("MenuD", msoBarPopup, , True)
For L = 1 To UBound(TabTemp, 1)
'1er niveau du menu
Set M = ElmtMenu(TabTemp(L, 1), CB, True)
'2ème niveau du menu
Set M1 = ElmtMenu(TabTemp(L, 2), M, True)
'3ème niveau du menu
Set M2 = ElmtMenu(TabTemp(L, 3), M1, True)
'3ème niveau du menu
Set M3 = ElmtMenu(TabTemp(L, 4), M2, False)
M3.OnAction = "'Maj """ & M.Caption & "|" & M1.Caption & "|" & M2.Caption & "|" & M3.Caption & """'"
Next L
'Affiche le menu
With Application.CommandBars("MenuD")
If .Controls.Count > 0 Then .ShowPopup
.Delete
End With
End Sub
Private Function ElmtMenu(ByVal T$, MenuParent As Object, Pop As Boolean) As Object
Dim M As CommandBarControl
On Error Resume Next
Set M = MenuParent.Controls(T)
On Error GoTo 0
If M Is Nothing Then
Set M = MenuParent.Controls.Add(IIf(Pop, msoControlPopup, msoControlButton), , , , True)
M.Caption = T
End If
Set ElmtMenu = M
End Function
Sub Maj(ByVal T As String)
Dim TabTemp() As String
Dim C As Byte
TabTemp = Split(T, "|")
For C = 0 To 3
ActiveCell.Offset(0, C).Value = TabTemp(C)
Next C
End Sub
Cordialement,
|
Didier FOURGEOT