Microsoft 365 ComBox directement dans la feuille

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With ComboBox1
    .Visible = False
    If Intersect(ActiveCell, [J4:J31]) Is Nothing Then Exit Sub
    .Left = ActiveCell.Left - .Width 'affichage à gauche de la cellule
    .Top = ActiveCell.Top
    .List = Array("RAPPELS", "NE PAS RAPPELER", "<effacer>")
    .Visible = True
    Application.OnTime 1, Me.CodeName & ".Deroule"
End With
End Sub

Private Sub Combobox1_Change()
Dim dat$
With ComboBox1
    If .ListIndex = -1 Then .Text = "": Exit Sub
    If .Text = "RAPPELS" Then
        .List = [Rappels].Value
    ElseIf .Text = "NE PAS RAPPELER" Then
        .List = [Ne_pas_Rappeler].Value
    ElseIf .Text = "<effacer>" And ActiveCell <> "" Then
        ActiveCell = Left(ActiveCell, Len(ActiveCell) - 1)
        ActiveCell = Left(ActiveCell, InStrRev(ActiveCell, "-"))
    ElseIf IsError(Application.Match(.Text, [Rappels], 0)) Then
        dat = Format(Date, "dd/mm/yy")
        ActiveCell = Trim(ActiveCell & " " & IIf(InStr(ActiveCell, dat), "", dat & " - ") & .Text & " -")
        [A1].Select 'la ComboBox se masque
    Else
        dat = Format(Date, "dd/mm/yy")
        ActiveCell = Trim(ActiveCell & " " & IIf(InStr(ActiveCell, dat), "", dat & " - ") & .Text & " -")
        .List = [OKRappels].Value
    End If
End With
ActiveCell.Activate
Application.OnTime 1, Me.CodeName & ".Deroule"
End Sub

Sub Deroule()
With ComboBox1
    If .Visible Then .Text = "": .Activate: .DropDown 'déroule la liste
End With
End Sub