Discussion :

[patricktoulon]

re bonjour unparia

Il va donc te falloir créer dynamiquement tant le Frame que le contrôle d'affichage

oui bien sur , la frame ,le texteboxt le bouton drop et les labels pour les ligne et colonnes
j'ajoute dynamiquement j'attribut l'évènement a chaque (ligne(label))
règle le pas de la scroll de la frame au height calculé avec ta super astuce
je m'y met tout a l'heure

[JahExodus]

Bonjour à tous et mercis pour votre aide précieuse,

Unparia, tu sembles m'avoir plutôt bien cerné

Je veux bien que l'on s'amuse à aller d'égarements en égarements, de trucs en trucs, etc ...
Je rappelle deux petites choses :
1) JahExodus est un étudiant
2) il nous parle d'un "demandeur". Ce dernier est très vraisemblablement son tuteur
3) il est plus que vraisemblable (et je le comprends ô combien) que ce "demandeur" ne souhaite et n'admettra aucune dépendance, que cette dernière soit à la présence et disponibilité de mscomctl.ocx ou qu'elle le soit à l'utilisation de scripts ou langages tiers (il les a peut-être de surcroît inhibés ).
Pijaku a exposé à juste titre l'idée d'un label "par-dessus". J'ai appuyé cette idée (me relire) en précisant qu'il fallait alors utiliser un second contrôle supplémentaire, tout en précisant que même cela s'écartait quelque peu d'une certaine rigueur et efficacité.

Le "demandeur" attend probablement plus volontiers une démonstration d'effort d'efficacité et de convivialité réelles exprimées autrement. Par l'utilisation, par exemple d'une combobox qui, elle, apporterait un réel "plus" (celui d'une recherche semi-automatique à partir de la zone d'édition, dans une colonne autre que la 1ère).
Pour résumer : nous avons là un étudiant. Gardons-nous de l'encourager à utiliser ce que son tuteur jugera inapproprié, s'il vous plait.

Mon "demandeur" n'est pas ici mon tuteur, mais j'ai en effet un tuteur derrière moi qui m'impose certaines règles, dont : "toujours utiliser des composants natifs à Excel 2003 ou antérieurs"-> Nous avions donc convenu d'utiliser des listbox.

J'avais posé cette question dansle but de savoir s'il existait un moyen simple de répondre à ce problème. Il semble donc qu'il y ait plusieurs solutions, mais pas forcément très simple pour un débutant comme moi.

L'application que je developpe n'étant pas encore fonctionnelle à 100%, je préfère m'attarder pour l'instant aux problématiques techniques et fonctionnelles avant de m'occuper des aspects graphiques qui selon moi sont bien moins important (a quoi ca sert d'avoir une belle appli si elle ne fonctionne pas ?). Tout ça pour vous dire que je mettrai en oeuvre une solution, mais un peu plus tard. Car cela risque de me prendre du temps, sachant que je galère déjà assez sur le côté fonctionnel.

Merci encore pour vos réponses

[unparia]

sachant que je galère déjà assez sur le côté fonctionnel.

J'approuve
Voilà en effet ce sur quoi il est primordial de concentrer toute ton attention.
Les "bébelles" -->> in fine. Jamais avant.
Amitiés à toi.

[patricktoulon]

oui c'est sur avant de faire de l'enjolivement graphique s'assurer que le fichier fonctionne ca c'est sur

@unparia voila après manger j'ai fait ceci
je n'arrive pas a faire fonctionner les évènements des labels seule la derniere ligne fonctionne
j'ai du me planter dans la boucle mais je ne sais ou
et le curseur de la scroll est absent(bizarre)

dans le userform un bouton et une combobox 2 colonnes 20 lignes

prévois la largeur d'userform suffisante pour voir 2 meme combobox alignée horizontalement (pour la demo

code userform

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Dim cL As New combofake
Private Sub CommandButton1_Click()
cL.combocolor ComboBox1, Array(&HC0FFFF, &HC0C0FF), True
End Sub
Private Sub UserForm_Activate()
Set plage = Range("A1:B20")
ComboBox1.ColumnCount = 2
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

code classe nommée "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
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)
    Dim cW, ecW#, ecL#, Fram, Ssel, Drop, i#, col#
 
    cW = Split("0;" & Replace(comb.ColumnWidths, " pt", ""), ";")
    Set Fram = comb.Parent.Controls.Add("Forms.Frame.1", "fond", True): Fram.Width = 100: Fram.Visible = False
    Set Ssel = comb.Parent.Controls.Add("Forms.textbox.1", "selectio", True)
    Set Drop = comb.Parent.Controls.Add("Forms.image.1", "drop", True)
    Ssel.Move comb.Left + comb.Width + 50, comb.Top, comb.Width, comb.Height
    Drop.Move Ssel.Left + Ssel.Width - Ssel.Height, Ssel.Top + 1, Ssel.Height - 2, Ssel.Height - 2
    Drop.SpecialEffect = 1
    Fram.Move Ssel.Left, Ssel.Top + Ssel.Height, Ssel.Width, Ssel.Width
    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)
        For col = 0 To comb.ColumnCount - 1
            Set ligne = Fram.Controls.Add("Forms.label.1", "l" & i * col, True)
            With ligne
                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: .BorderStyle = IIf(GriDline, 1, 0)
                .WordWrap = False: .Top = (.Height * i) - ecL: .Width = cW(col + 1): .Left = cW(col) - ecW: .AutoSize = False
                .BackColor = IIf(i Mod 2 = 0, bicolorbyrow(1), bicolorbyrow(0))
                Set usf(col).formm = comb.Parent: Set usf(col).framm = Fram: Set usf(col).combo = comb
                Set usf(col).dropp = Drop: Set usf(col).labLt = ligne: Set usf(col).selecté = Ssel
            End With
        Next
    Next
    With Fram
        .Height = .Controls(1).Height * comb.ListRows + IIf(GriDline, 5, 15): .ScrollBars = 2: ScrollHeight =  .Controls(1).Height * comb.ListRows +10
    End With
    'l'icone du bouton
    '82,36,73
    On Error Resume Next
    CommandBars("temp").Delete
    With ActiveSheet.Shapes.AddShape(82, 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
End Function
Private Sub dropp_Click()
    framm.Visible = True
    combo.DropDown
End Sub
Private Sub labLt_Click()
    MsgBox "coucou"
    'selecté.Value = labLt.Caption
End Sub
Private Sub formm_Click()
    framm.Visible = False
End Sub

[patricktoulon]

voila c'était juste une erreur d'indexation des subclasses

voila le code de la classe avec les évènements des lignes
dans ces évènement j'injecte dans le tag de la combo d'origine la colonne at applique l'index
donc l'évènement change d'origine de la combo te donne la ligne et la colonne
j'ai imiter a l'identique le comportement click dans userform dédrop la 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
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)
    Dim cW, ecW#, ecL#, Fram, Ssel, Drop, i#, col#, cc#
 
    cW = Split("0;" & Replace(comb.ColumnWidths, " pt", ""), ";")
    Set Fram = comb.Parent.Controls.Add("Forms.Frame.1", "fond", True): Fram.Width = 100: Fram.Visible = False
    Set Ssel = comb.Parent.Controls.Add("Forms.textbox.1", "selectio", True)
    Set Drop = comb.Parent.Controls.Add("Forms.image.1", "drop", True)
    Ssel.Move comb.Left + comb.Width + 50, comb.Top, comb.Width, comb.Height
    Drop.Move Ssel.Left + Ssel.Width - Ssel.Height, Ssel.Top + 1, Ssel.Height - 2, Ssel.Height - 2
    Drop.SpecialEffect = 1
    Fram.Move Ssel.Left, Ssel.Top + Ssel.Height, Ssel.Width, Ssel.Width
    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)
        For col = 0 To comb.ColumnCount - 1
            cc = cc + 1
            Set ligne = Fram.Controls.Add("Forms.label.1", "Lig" & i & "Ligcol" & col, True)
            ligne.Tag = "Lig" & i & "Ligcol" & col
            With ligne
                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:
                .BorderStyle = IIf(GriDline, 1, 0)
                .BorderColor = IIf(GriDline, GrildLineColor, 0)
                .WordWrap = False: .Top = (.Height * i) - ecL: .Width = cW(col + 1): .Left = cW(col) - ecW: .AutoSize = False
                .BackColor = IIf(i Mod 2 = 0, bicolorbyrow(1), bicolorbyrow(0))
                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 = ligne: Set usf(cc).selecté = Ssel
            End With
        Next
    Next
    With Fram
        .Height = .Controls(1).Height * comb.ListRows + IIf(GriDline, 5, 15): .ScrollBars = 3: ScrollHeight = 100
    End With
    'l'icone du bouton
    '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()
    framm.Visible = True
    framm.ScrollHeight = framm.Controls(1).Height * (framm.Controls.Count / combo.ColumnCount) - 1 * framm.Controls.Count / combo.ColumnCount
    combo.DropDown
    '
End Sub
Private Sub labLt_Click()
    formm.Controls(combo.Name).Tag = Split(labLt.Tag, "col")(1)
    formm.Controls(combo.Name).ListIndex = Split(labLt.Tag, "Lig")(1)
    selecté.Value = labLt.Caption
    framm.Visible = False
End Sub
Private Sub formm_Click()
    framm.Visible = False
End Sub

le code dans le userform

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
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 = ""
End Sub
Private Sub CommandButton1_Click()
cL.combocolor ComboBox1, Array(&HC0FFFF, &HC0C0FF), False, vbGreen
End Sub
Private Sub UserForm_Activate()
Set plage = Range("A1:B20")
ComboBox1.ColumnCount = 2
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

voila aucun composant particulier juste des composant basiques a l'image de mon faux calendrier dans les contribs

[unparia]

Tu n'es qu'au tout début des petits malheurs an traitant une classe, Patricktoulon
Et je vais te laisser continuer seul sur ce chemin dont je sais qu'il est ardu (je l'ai déjà suivi il y a quelques mois - et ce n'était que pour le "fun" - et n'ai pas l'intention de m'y remettre).
Juste une info : le traitement via une classe des seuls évènements ne suffit pas
Bon courage car tu vas y passer de nombreux jours

[patricktoulon]

non mais c'est bon ca fonctionne j'ai même ajouté le hover sur colonne
et les index ligne/colonne sont bien transmis a l'évènement change de la vrai combobox

je posterais le code dans les contributions

[unparia]

Bien, patricktoulon ..
Je vais donc attendre ce dépôt dans la section "Contributions".
Mais par pitié :
- ne te contente alors pas du dépôt d'un classeur à télécharger et ouvrir (je ne l'ouvrirai pas).
C'est ton code (et seulement ton code) que je regarderai, analyserai, etc ... pour te dire où le bât blesserait éventuellement ...
A ne pas procéder ainsi ... Tu auras tous les retours du monde, mais pas le mien, c'est clair.
- si tu le fais en observant cette règle, il n'est pas impossible (puisque je pourrai alors tester sans risques) que je pointe du doigt certains aspects ...
A plus, donc

[patricktoulon]

re
voila c'est fait c'est ICI combobox haut en couleur