Discussion :

[patricktoulon]

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


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

[unparia]

Bonjour
Mets toi à la place d'un utilisateur qui :
créerait un userform avec ce que tu as écrit
créerait un module de classe avec ce que tu as écrit
Et lancerait --->> plantage assuré.

Fais-le toi-même et tu constateras.

Tu vois pourquoi, non ?

[patricktoulon]

re
heu non je vois pas je viens de le faire
j'ai ouverts un nouveau classeur; copier tel quel les deux codes dans les modules adéquats(userform et classe )
nommé le module classe "combofake"
et lancer c'est nickel

[unparia]

heu non je vois pas je viens de le faire

et lancer c'est nickel

Ah bon ...

[patricktoulon]

je viens de me rendre compte que j'ai eu une méprise
la limite n'est pas en terme de taille mais de nombre de controls: 597 chez moi 199 lignes sur 3 colonnes
j'ai testé avec un font de 18 et 8 c'est pareil toujours 199 lignes
il faudra donc imposer une limite
il nous faut donc 601 sousclasse pour les cellules et les 54 control + userform inclus dans la classe

[pijaku]

Bonjour tout le monde,

Mets toi à la place d'un utilisateur qui :
créerait un userform avec ce que tu as écrit
créerait un module de classe avec ce que tu as écrit
Et lancerait --->> plantage assuré.

En effet, je confirme.
L'Option Explicit dans l'UserForm serait un bon début, et puis ou déclarer l'instance de Classe cL? Module? UserForm?

Ensuite, pourquoi créer autant de labels que de lignes et colonnes?
Limite l'affichage à 8 ou 10 lignes (comme dans une vraie combobox) et ne créées qu'autant de Labels.
Il te faudra, pour cela, à minima un contrôle supplémentaire, natif également, tu vois sans nul doute lequel .

[unparia]

Bonjour Franck
Comme patricktoulon a assuré sans sourciller ceci :

heu non je vois pas je viens de le faire
j'ai ouverts un nouveau classeur; copier tel quel les deux codes dans les modules adéquats(userform et classe )
nommé le module classe "combofake"
et lancer c'est nickel

j'ai préféré attendre qu'il le fasse réellement (ce qu'il n'avait bien évidemment pas fait contrairement à ce qu'il affirmait) ... et me suis donc tu en ce qui concerne l'utilisation de son Cl.
Il est surprenant que d'autres visiteurs ne se soient pas encore manifestés.
On va attendre que patricktoulon se réveille et complète comme il se doit ...
Amitiés

[pijaku]

Bonjour Jacques,

On va attendre que patricktoulon se réveille et complète comme il se doit ...

Et il y a encore du travail...
Ne serait ce que pour cet horrible barre de défilement horizontale !

[unparia]

Et il y a encore du travail...

Bien évidemment (et je le lui avais annoncé dans une autre discussion)

Ne serait ce que pour cet horrible barre de défilement horizontale

Et du sport, en ce qui concerne cet aspect

[pijaku]

il va falloir ajouter un control scrollbar

Oui, comme dit précédemment :

Il te faudra, pour cela, à minima un contrôle supplémentaire, natif également, tu vois sans nul doute lequel .

[patricktoulon]

re
oui le seul control supplementaire qu'il me faut c'est une scrollbar
je viens de tester ca match
cje finalise les index renvoiées tu t'en doute bien et met ca au propre
et je pose
très bonne idée
en attendant un appercu
pour la scroll H elle apparaitra que si l'originale l'avait
la scroll verticale chage juste les valeurs des 8 x colonnes dans la frame

[pijaku]

pour la scroll H elle apparaitra que si l'originale l'avait

Pense également, tout de suite, la même chose pour le cas ou tu n'as que trois lignes dans ta combobox ==> pas de scrollbar V et donc pas d'ajout de contrôle ScrollBar dans ce cas...