myDearFriend! a écrit : Bonsoir Gmarin, Guy, le Forum,

Ci-joint une autre façon de faire, mais toujours à base de PopUp CommandBars comme toi Guy

Dans le fichier en pièce jointe, j'ai appliqué le code suivant :

DANS LE MODULE DE CODE DE LA FEUILLE 2

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Application.Intersect(Target, Columns(1)) Is Nothing Then
        AffichMenuD Target(1).Text
    End If
End Sub

DANS UN MODULE DE CODE STANDARD (exemple : Module1)

'----------------------------------------
' myDearFriend!  -  www.mdf-xlpages.com
'----------------------------------------
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
    With Sheets("Feuil1")
        L = .Cells(.Rows.Count, 1).End(xlUp).Row
        TabTemp = .Range(.Cells(2, 1), .Cells(L, 3)).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, 2)) Like T & "*" Then
            '1er niveau du menu
            Set M = ElmtMenu(TabTemp(L, 2), CB, True)
            '2ème niveau du menu
            Set M1 = ElmtMenu(TabTemp(L, 3), M, True)
            '3ème niveau du menu
            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)
    ThisWorkbook.FollowHyperlink Sheets("Feuil1").Cells(L + 1, 1).Hyperlinks(1).Address
End Sub

Un paramètre à ne pas négliger toutefois : si la liste des éléments est vraiment longue, il faudra s'attendre à un léger délai avant affichage du menu déroulant lors du clic dans la cellule.

Cordialement,

Nb: je déplace ce fil qui ne s'adresse pas vraiment au débutant, dans le forum Principal Excel.