Titre du sujet : Re: Créer et Utiliser des listes de choix successives
par myDearFriend! le 07/10/2009 21:39:15
Bonsoir gmarin,
En pièce jointe, ton fichier modifié en conséquence.
J'ai modifié le code comme suit :
Option Explicit
'---------------------------------------------------------------------------------------
' Auteur : Didier FOURGEOT (myDearFriend!) - www.mdf-xlpages.com
' Date : 06/10/2009
' Sujet : Menu en cascade
'---------------------------------------------------------------------------------------
Sub AffichMenuD(T As String)
Dim CB As CommandBar
Dim M As CommandBarPopup, M1 As CommandBarPopup, M2 As CommandBarButton
Dim TabTemp
Dim L&
If T = "" Then Exit Sub
'On mémorise la liste des données (en plage A3:F? ici)
With Sheets("Feuil1")
L = .Cells(.Rows.Count, 1).End(xlUp).Row
TabTemp = .Range(.Cells(3, 1), .Cells(L, 6)).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)
If UCase(TabTemp(L, 4)) Like T & "*" Then
'1er niveau du menu (éléments en colonne 4 sur la feuille)
Set M = ElmtMenu(TabTemp(L, 4), CB, True)
'2ème niveau du menu (éléments en colonne 6 sur la feuille)
Set M1 = ElmtMenu(TabTemp(L, 6), M, True)
'3ème niveau du menu (éléments en colonne 1 sur la feuille)
Set M2 = ElmtMenu(TabTemp(L, 1), M1, False)
M2.OnAction = "'SuivreLien " & L & "'"
End If
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 SuivreLien(L As Long)
'Pour un fonctionnement "classique" (=visualisation dans le navigateur web),
'il convient d'activer la ligne ci-dessous (et désactiver les suivantes) :
' ThisWorkbook.FollowHyperlink Sheets("Feuil1").Cells(L + 2, 6).Hyperlinks(1).Address
'Pour un fonctionnement avec contrôle WebBrowser directement sur la feuille Excel :
Sheets("Feuil2").WebBrowser1.Navigate Sheets("Feuil1").Cells(L + 2, 6).Hyperlinks(1).Address
End Sub
J'ai également essayé d'interpréter et d'apporter une réponse au dernier point :
Citation : gmarin a écrit :
Question supplémentaire : les liens hypertexte peuvent-ils être affichés directement dans la feuille Excel, plutôt que dans l'IExplorer ? 
Tu verras dans le classeur qu'il est possible d'intégrer directement sur la feuille de calcul un contrôle Webbrowser pour afficher les url pointées par le menu en cascade... A toi de voir si cette façon de faire est mieux ou non...
Cordialement,
|
Didier FOURGEOT