Bonjour a tous
Une demande a été faite récemment quand au fait de mettre en évidence par la couleur (back/font)le lignes ou colonne ou items d'un controls listbox
la réponse est non bien évidement sauf utilisation des apis Windows et GDI un vrai carcans a décoder le code pour le non avertis
d'autant plus que c'est pas toujours fonctionnels selon le PC (librairies inhibées et autres)

Alors dans le même esprit que ma contribution sur le "un calendrier pour tous" je vous ai fait une combobox
a savoir uniquement l'utilisation de controls basiques disponibles dans tout PCs ayant une installation d'office digne de ce nom
le tout bien entendu comme le calendrier; dans une classe dynamique
la particularité de cette pseudo combobox c'est qu'elle transmet l'index de selection(ligne/colonne) a l'évènement combobox original
vous pouvez ainsi garder votre code initial des évènements dans l'userform moyennant de vider le tag en fin d'évènements comme dans la démo qui suit

a lors voila nous y somme
j'ai mis des commentaires partout ou il y en avait besoins pour ceux qui souhaiteraient décortiquer le code en essayant de l'aérer au plus possible

code module classe nommé"combofake"
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
Option Explicit
Public WithEvents framm As MSForms.Frame
Public WithEvents formm As UserForm
Public WithEvents dropp As MSForms.Image
Public WithEvents selecté As MSForms.TextBox
Public WithEvents labLt As MSForms.Label
Public WithEvents combo As MSForms.ComboBox
Private usf(100) As New combofake
Function combocolor(comb, bicolorbyrow, Optional GriDline As Boolean = False, Optional GrildLineColor As Variant = vbBlack, Optional overcolor As Variant = vbCyan)
    Dim cW, ecW#, ecL#, Fram, Ssel, Drop, i#, col#, cc#, ccol#, cel, mabarre, bouton
    comb.Parent.Tag = overcolor    'memorisation de la couleur OVER dans tag du userform
    cW = Split(Replace(comb.ColumnWidths, " pt", ""), ";")    'columnwidths  de la combobobox originale vers un array
    'ajout de la frame
    Set Fram = comb.Parent.Controls.Add("Forms.Frame.1", "fond", True): Fram.Width = 100: Fram.Visible = False
    'ajout du textbox (combobox
    Set Ssel = comb.Parent.Controls.Add("Forms.textbox.1", "selectio", True)
    'ajout du bouton dropdown
    Set Drop = comb.Parent.Controls.Add("Forms.image.1", "drop", True)
    Drop.SpecialEffect = 1    'juste pour avoir le meme effet de bordure que l'original
    'placement des controls de base
    Ssel.Move comb.Left, comb.Top, comb.Width, comb.Height
    Drop.Move comb.Left + comb.Width - comb.Height, comb.Top + 1, comb.Height - 2, comb.Height - 2
    Fram.Move comb.Left, comb.Top + comb.Height, comb.Width, comb.Width
    'boucle sur la liste (ligne/colonnes)
    For i = 0 To comb.ListCount - 1
        ecL = IIf(GriDline, IIf(i > 0, 1 * i, 0), 0)    'on enleve 1*i pour que les borduretop et bottom se croisent (effet BORDERCOLLAPSE)
        ccol = 0
        For col = 0 To comb.ColumnCount - 1
            cc = cc + 1    'DECOMPTE pour alimenter les sousclasses(usf(1 a X)
            'ajout item(ligne/colonne)
            Set cel = Fram.Controls.Add("Forms.label.1", "Lig" & i & "Ligcol" & col, True)
            With cel
                ecW = IIf(GriDline, IIf(col > 0, 1 * col, 0), 0)    'on enleve 1*i pour que les bordureright et left se croisent (effet BORDERCOLLAPSE)
                .Caption = comb.List(i, col): .AutoSize = True: .Font.Size = comb.Font.Size:    'alimentation des propriétés
                .BorderStyle = IIf(GriDline, 1, 0)    'bordure(gridline)
                .BorderColor = IIf(GriDline, GrildLineColor, 0)    'couleur du gridline
                .WordWrap = False: .Top = (.Height * i) - ecL:
                'maintenant que l'on a le height on enleve le autosize et met le widh a la dimention des columnswidths
                .Left = ccol - ecW: .AutoSize = False: .Width = cW(col):
                .BackColor = IIf(i Mod 2 = 0, bicolorbyrow(1), bicolorbyrow(0)): .Tag = .BackColor    'memorisation du backcolor du label pour le rollOVER
                'enregistrement des parties dans les sousclasses pour la gestion des evenements (click,move)
                Set usf(cc).formm = comb.Parent: Set usf(cc).framm = Fram: Set usf(cc).combo = comb
                Set usf(cc).dropp = Drop: Set usf(cc).labLt = cel: Set usf(cc).selecté = Ssel
            End With
            ccol = ccol + Val(cW(col))
        Next
    Next
    'dimentionnement (equivalent a listrows pour l'original)
    With Fram
        .Height = .Controls(1).Height * comb.ListRows + IIf(GriDline, 5, 15): .ScrollBars = 3:
    End With
    'du tunning encore du tunning l'icone du bouton dropdown
    '82,36,73
    On Error Resume Next
    CommandBars("temp").Delete
    With ActiveSheet.Shapes.AddShape(36, 10, 10, 10, 15): .Line.Visible = False: .Fill.ForeColor.RGB = (vbBlue): .Fill.Visible = True: .Copy: .Delete: End With
    Set mabarre = CommandBars.Add("temp", msoBarPopup, False, True): Set bouton = mabarre.Controls.Add(Type:=msoControlButton):
    bouton.PasteFace
    Drop.Picture = bouton.Picture
    On Error Resume Next
    CommandBars("temp").Delete
    comb.Visible = False
 
End Function
Private Sub dropp_Click()
    Dim the_next
    framm.Visible = True
    Set the_next = framm.Controls("Lig" & combo.ListCount - 1 & "Ligcol" & combo.ColumnCount - 1)
    'reglage des scrolls a l'identique  de l'originale
    framm.ScrollWidth = the_next.Left + the_next.Width
    framm.ScrollHeight = the_next.Top + the_next.Height
End Sub
Private Sub labLt_Click()
    formm.Controls(combo.Name).Tag = Split(labLt.Name, "col")(1)    'memorisation de l'index colonne dans le tag de la combobox originale
    formm.Controls(combo.Name).ListIndex = Split(labLt.Name, "Lig")(1)    'modification de la propriété listindex de la combobox originale
    selecté.Value = labLt.Caption    'le textbox de substitution du haut de la combobox prent la valeur de l'item cliqué(ligne/colonne)
    framm.Visible = False    'fermeture frame(imite le comportement de l'originale
End Sub
 
'effet mose OVER
'vous trouverez ce principe dans quasi toutes mes contributions sur les userforms et ses controls
'application de la couleur
Private Sub labLt_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If framm.Tag <> "" Then
        If framm.Tag <> labLt.Name Then
            framm.Controls(framm.Tag).BackColor = framm.Controls(framm.Tag).Tag
        End If
    End If
    framm.Tag = labLt.Name
    labLt.BackColor = formm.Controls(1).Parent.Tag
End Sub
'remise de la couleur initiale sur l'evenement frame et userform
Private Sub framm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If framm.Tag <> "" Then framm.Controls(framm.Tag).BackColor = framm.Controls(framm.Tag).Tag
End Sub
Private Sub formm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If framm.Tag <> "" Then framm.Controls(framm.Tag).BackColor = framm.Controls(framm.Tag).Tag
End Sub
Private Sub formm_Click()
    framm.Visible = False 'fermeture de la fram(imite le comportement de l'originale)
End Sub
et voila un exemple d'utilisation
dans le userform une combobox et un bouton
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
dim Cl as new combofake
Private Sub ComboBox1_Change()
t = "combobox1.listindex = " & ComboBox1.ListIndex & vbCrLf
If ComboBox1.Tag <> "" Then t = t & "combobox1.columnIndex = " & ComboBox1.Tag
MsgBox t
ComboBox1.Tag = "" 'remise a zero(IMPORTANT!!!!!)
End Sub
Private Sub CommandButton1_Click()
' apel a la fonction de la creation de la pseudocombobox
cL.combocolor ComboBox1, Array(&HC0FFFF, &HC0C0FF), True, vbGreen, vbRed
End Sub
 
Private Sub UserForm_Activate()
Set plage = Range("A1:c20")
ComboBox1.Font.Size = plage.Cells(1).Font.Size
ComboBox1.ColumnCount = plage.Columns.Count
ComboBox1.List = plage.Value
For i = 1 To plage.Columns.Count
cW = cW & plage.Columns(i).Width & IIf(i < plage.Columns.Count, " pt;", "")
Next
ComboBox1.ColumnWidths = cW
End Sub
une petite démo pour changer
Nom : demo.gif Affichages : 935 Taille : 1,10 Mo

un petit bémol cependant
la limite de lignes étant fixée par le maximum d'un height de la frame soit pour
un font size de 12 =199 lignes soit un height de 10.8 points X 199 soit environ 2550 points