Microsoft 365 Création d'un combobox avec uniquement des couleurs

Option Explicit
Sub menucolor()
    Dim cmb As Object, i&
    On Error Resume Next
    CommandBars("menucolor").Delete
    On Error GoTo 0
    Set cmb = CommandBars.Add(Name:="menucolor", Position:=msoBarPopup, Temporary:=True)
    For i = 1 To 10
        With cmb.Controls.Add(msoControlButton)    '<-- création du bouton
            Cells(1, 1).Interior.ColorIndex = i
            Cells(1, 1).CopyPicture
            .Caption = "couleur " & i    '<-- texte du bouton
            .PasteFace    '<-- collage de l'image issue du presse-papier
            .Tag = Cells(1, 1).Interior.Color
            .OnAction = "couleur"
        End With
    Next
    cmb.ShowPopup
    On Error Resume Next
    CommandBars("menucolor").Delete
    On Error GoTo 0
End Sub

Sub couleur()
    With CommandBars.ActionControl
        MsgBox "la couleur choisie est la couleur """ & .Caption & """ son code est " & .Tag
    End With
End Sub

Option Explicit
Sub menucolor()
    Dim cmb As Object, i&, shapo
    On Error Resume Next
    CommandBars("menucolor").Delete
    On Error GoTo 0
    Set cmb = CommandBars.Add(Name:="menucolor", Position:=msoBarPopup, Temporary:=True)
   Set shapo = ActiveSheet.Shapes.AddShape(msoShapeOval, 10, 10, 20, 20)
    For i = 1 To 10
        With cmb.Controls.Add(msoControlButton)    '<-- création du bouton
            With shapo
                .Name = "shapo"
                .OLEFormat.Object.Interior.ColorIndex = i
                .CopyPicture
            End With
            .Caption = "couleur " & i    '<-- texte du bouton
            .PasteFace    '<-- collage de l'image issue du presse-papier
            .Tag = ThisWorkbook.Colors(i)
            .OnAction = "couleur"
        End With
    Next
    cmb.ShowPopup
    shapo.Delete
    On Error Resume Next
    CommandBars("menucolor").Delete
    On Error GoTo 0
End Sub

Sub couleur()
    With CommandBars.ActionControl
        MsgBox "la couleur choisie est la couleur """ & .Caption & """ son code est " & .Tag
    End With
End Sub

#If Win32 Then
Private Type ChooseColor
    lStructSize               As Long
    hwndOwner                 As Long
    hInstance                 As Long
    rgbResult                 As Long
    lpCustColors              As Long
    flags                     As Long
    lCustData                 As Long
    lpfnHook                  As Long
    lpTemplateName            As String
End Type
Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long
#Else
Private Type ChooseColor
    lStructSize               As Long
    hwndOwner                 As LongPtr
    hInstance                 As LongPtr
    rgbResult                 As Long
    lpCustColors              As LongPtr
    flags                     As Long
    lCustData                 As LongPtr
    lpfnHook                  As LongPtr
    lpTemplateName            As String
End Type
Private Declare PtrSafe Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long
 
#End If
Private Enum cons
    CC_ANYCOLOR = &H100
    CC_ENABLEHOOK = &H10
    CC_ENABLETEMPLATE = &H20
    CC_ENABLETEMPLATEHANDLE = &H40
    CC_FULLOPEN = &H2
    CC_PREVENTFULLOPEN = &H4
    CC_RGBINIT = &H1
    CC_SHOWHELP = &H8
    CC_SOLIDCOLOR = &H80
End Enum
Sub test()
Debug.Print DialogColor
End Sub
Public Function DialogColor(Optional lDefaultColor As Variant= "6646548") As Long
    Dim CC                    As ChooseColor
    Dim lRetVal               As Long
    Static CustomColors(16)   As Long
 
    'Some predefined color, there are 16 slots available for predefined colors
    'You don't have to defined any, if you don't want to!
    CustomColors(0) = RGB(255, 255, 255)    'White
    CustomColors(1) = RGB(0, 0, 0)          'Black
    CustomColors(2) = RGB(255, 0, 0)        'Red
    CustomColors(3) = RGB(0, 255, 0)        'Green
    CustomColors(4) = RGB(0, 0, 255)        'Blue
 
    With CC
        .lStructSize = LenB(CC)
        .flags = CC_ANYCOLOR Or CC_FULLOPEN Or CC_PREVENTFULLOPEN Or CC_RGBINIT
        If IsNull(lDefaultColor) = False _
           And IsMissing(lDefaultColor) = False Then .rgbResult = lDefaultColor    'Set the initial color of the dialog
        .lpCustColors = VarPtr(CustomColors(0))
    End With
    lRetVal = ChooseColor(CC)
    If lRetVal = 0 Then
        'Cancelled by the user
        DialogColor = RGB(255, 255, 255)    ' White
    Else
        DialogColor = CC.rgbResult
    End If
End Function

Sub Test1()
    Range("F10:F15").Interior.Color = ChoixCouleur
End Sub

Private Function ChoixCouleur() As Long
    If Application.Dialogs(xlDialogEditColor).Show(10) Then
        ChoixCouleur = ActiveWorkbook.Colors(10)
    Else
        'Annulation
    End If
End Function

Sub Test1()
    couleur = ChoixCouleur
    If couleur > -1 Then Range("F10:F15").Interior.Color = couleur
End Sub

Private Function ChoixCouleur() As Long
    If Application.Dialogs(xlDialogEditColor).Show(2, 255,100 , 0) Then
        ChoixCouleur = ActiveWorkbook.Colors(2)
    Else
        ChoixCouleur = -1
    End If
    On Error Resume Next
    ActiveWorkbook.Colors.Reset    ' pour réinitialiser la couleur (index utilisé "2")
End Function