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

[popcorn9]

Bonjour à tous ,

Je suis débutant en VBA, je me lance dans la programmation.

J'aimerais crée un combobox, dans lequel il y aurait le choix de plusieurs couleurs.

Puis lorsque l'on sélectionne cette couleur, elle s'applique a une ligne de ma listview. Et quand la couleur est choisi, elle s'enleve du combobox.

Merci par avance 🙂

 

[Robert]

Re,

Même combat !... Pas de fichier, pas de chocolat...

 

[Dranreb]

Bonjour.
Attention: Les ListView finissent souvent par poser des problèmes de portabilité, mais sont les seules à proposer une propriété ForeColor pour le texte de leurs membres ListItem et ListSubItem. Mais toujours pas de propriété BackColor pour en changer la couleur de fond.
Des Label créés dynamiquement le permettraient par contre, et ne poseraient jamais de problème de portabilité.

 

[Dudu2]

Bonjour,

En utilisant une ListView et la Font Webdings, le caractère 'g' représente un carré plein juxtaposable sans espace latéral et peut être coloré pour donner la sensation d'un fond coloré.

A noter que personnellement, je n'ai jamais créé de ListView et serais bien embarrassé de le faire.
Peut-être est-ce dans Active-X / Autres contrôles ?

 

[Dudu2]

Ou alors tu utilises un UserForm de ce genre.

Edit: Fichier supprimé

 

[Dudu2]

Ou plutôt celui-ci car Excel ne se remet pas bien d'une fermeture par le menu système dans le précédent.

 

[patricktoulon]

bonsoir à tous
perso je ne m'ennuierais pas avec un userform
un simple menu contextuel
vite fait comme ça

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

 

[Dudu2]

Bonjour @patricktoulon,
Solution intéressante. Je ne connaissais pas ce système de CommandBar.

 

[ChTi160]

Bonjour le Fil,
Où en ait-on par rapport à la demande initiale :

Puis lorsque l'on sélectionne cette couleur, elle s'applique a une ligne de ma listview. Et quand la couleur est choisi, elle s'enleve du combobox.

Merci
Bonne journée
Jean marie

 

[Dranreb]

Bonjour.
On a vu que ce n'était pas possible avec une ComboBox pour le choix de la couleur.
Avec une ListView aussi pour ça, ce ne serait possible que pour les couleurs de police.
Ce serait possible aussi pour les couleurs de fond avec une collection de Label dans un Frame comme dans ce classeur, mais ça reste à faire …

 

[patricktoulon]

Bonjour @Dudu2 c'est vieux pourtant ce truc
je l'ai donner des centaine de fois ce model de base
le voila avec des icons ronds(on peux utiliser n'importe quelle forme)

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

apres en ce qui concerne la demande je peux vous en faire un autre aussi 😉

 

[Dudu2]

@patricktoulon, merci pour l'explication. Je préfère avec une Shape.
@Dranreb, belle réussite, c'est l'artillerie lourde !

 

[dysorthographie]

Bonjour,

#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

 

[Dudu2]

Bonjour @dysorthographie

Ça m'a rappelé que j'avais quelque part un équivalent en version courte de ton code avec une interface différente.

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

 

[patricktoulon]

Bonjour @Dudu2
elle n'est pas complète ta version
tu peux choisir une couleur de départ (RGB)
et ne pas oublier de faire un reset sinon tu a ta pâlette de 56 couleur modifié sur l'index que tu a choisi "10") chez toi

exemple ici on demarre a la couleur rouge (index(2) et on la demarre en orange)
tu constatera aussi que l'apalette s'affiche sur son 2d onglet

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