Accéder à une liste d'image en cliquant sur une image

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Range("N8:N26"), Target) Is Nothing Then
        Call Plag_N
    End If
End Sub

Option Explicit
    Public cb As CommandBar
    Public Liste_1 As Range
    Dim i, nbl As Long

Sub Plag_N()
   Set Liste_1 = Sheets("Feuil1").Range("Critère_C")
    If Liste_1.Columns.Count > 1 Then Exit Sub
    On Error Resume Next
    CommandBars("Menu_Gw").Delete
    On Error GoTo 0
    Set cb = Application.CommandBars.Add("Menu_Gw", msoBarPopup)
    nbl = Liste_1.Count
    For i = 1 To nbl
        ThisWorkbook.Sheets("Feuil1").Shapes(Liste_1(i)).Copy
        With cb.Controls.Add(msoControlButton, 1, Liste_1(i), , True)
            .PasteFace
            If ActiveCell.Column = 15 Then .Caption = .Parameter   'pour afficher que les smiley mettre la colonne en erreur N= 14 si différent de 14 affichage simple
            .OnAction = "Note_N(" & i & ")"
        End With
    Next i
    cb.ShowPopup
    Set Liste_1 = Nothing
    ActiveCell(1, 0).Select
End Sub

Sub Note_N(index As Long)
  ActiveCell = cb.Controls(index).Parameter
  If ActiveCell = "Rire" Then
    ActiveCell = "J"
    ActiveCell.Font.ColorIndex = 4
  ElseIf ActiveCell = "Neutre" Then
    ActiveCell = "K"
    ActiveCell.Font.ColorIndex = 45
  ElseIf ActiveCell = "Mal" Then
    ActiveCell = "L"
    ActiveCell.Font.ColorIndex = 3
  ElseIf ActiveCell = "Muet" Then
    ActiveCell = ""
    ActiveCell.Font.ColorIndex = xlNone
  End If
End Sub