Affiché listbox a chaque cellule d'une colonne

Option Explicit

Const TheCol As Byte = 1

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim TheListe As String
If Application.Intersect(Target, Columns(TheCol)) Is Nothing Then Exit Sub

    TheListe = 'mauvais, bon, très bon, genial'

    With Target
        With .Validation
            .Delete
            .Add Type:=xlValidateList, _
            Operator:=xlBetween, _
            Formula1:=TheListe
        End With
    End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, Columns(TheCol)) Is Nothing Then Exit Sub

    Target.Validation.Delete

End Sub

Cliquez pour agrandir...