Discussion :

[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...

[patricktoulon]

re
et voila la version avec juste le listerow* columncount en terme de label
les deux scroll bar sont gérées identiquement a l'original

classe

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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
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 memo As MSForms.Label
Public WithEvents combo As MSForms.ComboBox
Public WithEvents scrol As MSForms.ScrollBar
Private usf(100) As New combofake2
Function combocolor(comb, bicolorbyrow, Optional GriDline As Boolean = False, Optional GrildLineColor As Variant = vbBlack, Optional overcolor As Variant = vbCyan, Optional listrow As Variant = False)
    Dim cW, ecW#, ecL#, Fram, Ssel, Drop, lig#, col#, cc#, ccol#, cel, mabarre, bouton, countrows#, ccwidth#, Hheight, lab, scro
    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
    If listrow = False Then listrow = comb.ListRows
    Set lab = comb.Parent.Controls.Add("Forms.label.1", "memo" & col, True)
    With lab: .Caption = listrow - 1: .Font.Size = comb.Font.Size:
        .AutoSize = True:
        Hheight = .Height:
        .Top = -15
    End With
 
    'ajout de la frame
    Set Fram = comb.Parent.Controls.Add("Forms.Frame.1", "fond", True): Fram.Width = 100: Fram.Visible = False
    'ajout de la scrollbars verticale
    Set scro = comb.Parent.Controls.Add("Forms.scrollbar.1", "scrol", True): Fram.Width = 100: scro.Tag = listrow - 1: scro.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 + 30 + comb.Width, comb.Top, comb.Width, comb.Height
    Drop.Move Ssel.Left + Ssel.Width - comb.Height + 5, Ssel.Top + 1, comb.Height - 5, comb.Height - 1
    Fram.Move Ssel.Left, comb.Top + comb.Height, comb.Width - Drop.Width, comb.Width, Hheight * listrow
    scro.Move Ssel.Left + Ssel.Width - Drop.Width, Fram.Top + 1, Drop.Width, Fram.Height
    For lig = 0 To listrow - 1
        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" & lig & "Ligcol" & col, True)
            With cel
                .Caption = "  " & comb.List(lig, col): .Height = Hheight: .Font.Size = comb.Font.Size:    'alimentation des propriétés
                .BorderStyle = IIf(GriDline, 1, 0)  'bordure(gridline)
                .BorderColor = IIf(GriDline, GrildLineColor, .BackColor)    'couleur du gridline
                .WordWrap = False:    '    .SpecialEffect = 0
                .Left = ccol: .Width = cW(col): .Top = (.Height * lig):
                If col = comb.ColumnCount - 1 And ccol < Fram.Width - 10 Then .Width = .Width + (Fram.Width - 10) - ccol - 5
                .BackColor = IIf(lig 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).memo = lab
                Set usf(cc).dropp = Drop: Set usf(cc).labLt = cel: Set usf(cc).selecté = Ssel: Set usf(cc).scrol = scro
            End With
            ccol = ccol + Val(cW(col))
        Next
    Next
    'dimentionnement (equivalent a listrows pour l'original)
    With Fram
        .Height = (Hheight * listrow) + 1
        If ccol > .Width - 10 Then .ScrollBars = 1: .Height = .Height + Hheight + 3: Fram.ScrollWidth = ccol + 1: scro.Height = .Height
 
    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(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
    'comb.Visible = False
 
End Function
Private Sub scrol_Change()
    Dim cc, lig, col, LroW
    cc = -1: LroW = scrol.Tag
    For lig = scrol.Value To LroW + scrol.Value
        For col = 0 To combo.ColumnCount - 1: cc = cc + 1: framm.Controls(cc) = "  " & combo.List(lig, col): Next
    Next
End Sub
Private Sub scrol_Scroll()
    Dim cc, lig, col, LroW
    cc = -1: LroW = scrol.Tag
    For lig = scrol.Value To LroW + scrol.Value
        For col = 0 To combo.ColumnCount - 1: cc = cc + 1: framm.Controls(cc) = "  " & combo.List(lig, col): Next
    Next
End Sub
Private Sub dropp_Click()
    framm.Visible = True
    With scrol: .Visible = True: .Max = combo.ListCount - scrol.Tag - 1: .Min = 0: .Value = 0: .LargeChange = 1: .Height = framm.Height: End With
    If scrol.Tag = combo.ListCount - 1 Then scrol.Visible = False: framm.Width = selecté.Width:
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 = scrol.Value + Val(Split(labLt.Name, "Lig")(1))    'modification de la propriété listindex de la combobox originale
    selecté.Value = Mid(labLt.Caption, 3, 1000)  'le textbox de substitution du haut de la combobox prent la valeur de l'item cliqué(ligne/colonne)
    framm.Visible = False: scrol.Visible = False    'fermeture frame(imite le comportement de l'originale
End Sub
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
    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: scrol.Visible = False    'fermeture frameet scroll(imite le comportement de l'originale
'fermeture de la fram(imite le comportement de l'originale)
End Sub

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
20
21
Dim cL As New combofake2
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), False, vbGreen, vbRed
End Sub
Private Sub UserForm_Activate()
Set plage = Range("A1:D1000")
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

listrows=listcount pas de scroll

listcount > listrows

listrows=listcount et width retreci

listcount>listrows et retreci

[unparia]

Re salut Patricktoulon
Si tu te demande pourquoi j'attends pour intervenir et pourquoi d'autres n'interviennent pas -->>
Complète s'il te plait ton tout premier message, dans lequel tu as oublié un "petit détail".
Je vais te la mettre, la puce à l'oreille, puisque tu sembles avoir des difficultés d'ouïe : il manque la mention de l'ajout nécessaire d'un module standard et de ce qui doit y être écrit.
J'attends... J'attends ...
(je refuse de dire quoi que ce soit d'autre tant que cela n'aura pas AU MOINS été fait).

[patricktoulon]

heuh.....
si tu avais pris la peine de lire le code a fond et même essayé tu aurais compris qu'il n'est null besoins de module standard
seulement le code dans le userform et celui de la classe c'est justement mon cheval de bataille

ha!!.... puré

tu a juste besoins de la classe
et de :
en haut de module userform

Code :

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

Dim cL As New combofake2

dans un evenement userform(bouton ou meme activate)

Code :

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

cL.combocolor ComboBox1, Array(&HC0FFFF, &HC0C0FF), False, vbGreen, vbRed, 8

classe.fonctiondecreation argument1=nomdela combo,argument2 array de 2 couleur pour les ligne ,true/false pour le gridline,couleur pour le grideline ,couleur over ,listrows voulu

cela
true/false pour le gridline,couleur pour le grideline ,couleur over ,listrows voulu
sont optional et ont donc un par defaut si omis

pas besoins de Module standard!!!

[pijaku]

Même s'il est vrai que la déclaration au niveau module Userform de la variable cL suffit en elle-même, il convient également (surtout dans le forum contribution) de déclarer les autres variables.
Je sais, on chipote.
Mais mon "petit" vécu des forums me fait conseiller systématiquement tous ces "petits" détails.
ça évite bien souvent des : "ça marche pas"...
Déclare donc maintenant toutes tes variables de l'userform (t, plage, i, cW).
Je reviens demain pour tester ton code.

Je supposes que cela a déjà bien progressé, et t'en félicites par avance.

Bonne soirée à vous deux (et aux éventuels lecteurs) !

EDIT :
Ah oui, j'oubliais.
Toute contribution doit être exhaustive ET rigoureusement précise.
Tu dois "annoncer" au futur utilisateur comment nommer le module de classe.
Depuis le début de cette discussion, il a changé de nom et, un novice qui chercherai à utiliser ton code, serait complètement "out"...

Ne vois mes remarques que d'un point de vue purement pédagogique.

[unparia]

Je ne dis pas le contraire, patricktoulon.
Dans la partie déclarative du userform, si tu préfères ainsi ... (je préfères quant à moi une déclaration publique dans un module standard, pour une bonne raison : l'utilisation de la même classe, déclarée une fois pour toutes, depuis plusieurs endroits, mais ce n'est là qu'un détail)
Mais dis-moi : où (relis ton premier message) as-tu fait cette déclaration indispensable ? (je ne la vois pas, mais toi, tu vas me le dire) ...
Tu voudras dès lors bien comprendre qu'un visiteur néophyte se demandera pourquoi ça plante.
Et maintenant que tu le sais --->> qu'attends-tu pour le compléter, ton 1er message ?

[patricktoulon]

as-tu fait cette déclaration indispensable

je vois pas de quoi tu parle
quand tu le dira enfin peut être qu'on pourra échanger

il n'est null besoins d'un module standard pour se servir d'une classe control X fois dans le même userform je le prouve largement avec le pseudo calendrier

les propriété Let et Get sont manipulable a volonté
bref dis moi de quoi tu parle parce que plus tu interviens plus tu me perds

arrête avec tes "crois tu?" ,etc.....c'est d'aucune utilité on est a deux pages et on se comprends toujours pas alors annonce la couleur sinon laisse tomber ca pourri ma contrib
les module standard a la con laisse tomber je n'en veux pas dans mes exercices ,c'est aussi mon but de facon a faire des bas et cls transportables et exportables

[unparia]

bref dis moi de quoi tu parle parce que plus tu interviens plus tu me perds

De la chose la plus simple du monde ! de l'absence de la déclaration nécessaire de Cl (que tu la fasses dans le module du UserForm ou dans un module standard).
Elle n'est nulle part présente dans ton code. Et cette absence fait donc planter, avec option Explicit ou sans Option Explicit.
Je te fais un dessin ?

EDIT : j'ai tout fait pour te conduire à la découverte de cet oubli. Je t'ai même demandé de te mettre à la place d'un visiteur et de faire TRES EXACTEMENT ce que tu avais écrit. En le faisant, tu t'en serais rendu compte.
Mais tu m'as assuré (et répété) que tu l'avais fait (que nenni) et ne comprenais pas.
Dès lors, ma foi ....

[unparia]

Ah ça y est ... Enfin ajouté ...
Je te dirai alors demain ce que j'en pense.

[unparia]

Juste une réponse précise, maintenant :
Laquelle de tes versions veux-tu que je teste ?

Je viens de tester la première -->> Pas bonne du tout (il m'a suffi de très peu pour qu'elle affiche de manière erronée, voire n'affiche pas tout) -->> poubelle

Je testerai la dernière demain.

[unparia]

De bon matin en test sur la dernière de tes versions.

1) Je vais à ce stade laisser de côté les aspects gênants fondamentaux (la liste est très longue) de cette manière de procéder. C'est payer bien cher et perdre beaucoup pour gagner bien peu. On en reparlera à la fin

2) je ne vais donc parler ce matin que de mes premières observations liées au seul traitement du seul visuel --->>

Si l'on survole un article de la dernière colonne visible et que l'on glisse rapidement vers l'ascenseur vertical :
- l'article survolé (passé au "rouge"), reste en rouge -->> à corriger (assez facile)
- si l'on utilise alors l'ascenseur, la zone rouge reste rouge et à ses coordonnées et ne correspond donc plus au même article. ce qui peut tromper de manière gênante l'utilisateur -->> à compléter (ce ne sera pas léger)

Il a été prévu de "replier" la combobox pour imiter le fonctionnement d'une combobox "normale". Le hic : ce "repli" nécessite un clic sur le UserForm alors qu'il devrait être subordonné au clic sur tout contrôle autre que celui actif.
L'utilisateur pensera-t-il qu'il lui faut cliquer sur ... le Userform ?

Voilà pour ce matin.

[pijaku]

Bonjour,

Le résultat de mes premiers tests :

1. L'affichage de la dernière ligne (ligne 1000 dans ton exemple) est tronqué si la taille de police est inférieure à 10,
2. Le clic sur le "drop bouton" si la combo est ouverte devrait la refermer,
3. Normalement, le height d'une scrollbar verticale d'une combobox est plus petit que le height de son "frame", pas sur ta combofake,
4. Normalement, le clic sur une ligne amène comme résultat, dans le textbox, la valeur de sa première colonne, pas sur ta combofake,
5. Si le scroll H n'est pas affiché, il manque 2-3 points en hauteur des derniers labels,
6. Mêmes remarques que Jacques à propos du "rouge", du scroll et du clic sur n'importe quel contrôle,
7. Purement esthétique, je n'aime pas trop cette grosse flèche bleue...

Je préfères également, pour ma seule compréhension, un code composé de courtes fonctions, plutôt que ton gros pavé de Function.
ça se discute, mais je trouve plus maintenable un code plus court.
Dans ton cas (création d'un objet "contrôle"), tu pourrais jouer avec des Property.

EDIT : Bonjour Jacques,

1) Je vais à ce stade laisser de côté les aspects gênants fondamentaux (la liste est très longue) de cette manière de procéder. C'est payer bien cher et perdre beaucoup pour gagner bien peu. On en reparlera à la fin

Je trouve dommage de n'en parler qu'à la fin si ces aspects sont fondamentaux.

[unparia]

Bonjour Franck

Je trouve dommage de n'en parler qu'à la fin si ces aspects sont fondamentaux.

Tu as sacrément raison, mais
1)
http://www.expressio.fr/expressions/...eau-froide.php
2) si je le faisais maintenant (trop d'expériences malheureuses) patricktoulon s'éparpillerait et plus personne ne se retrouverait sans suer dans une espèce de brouillard épouvantable.

3) cela conduirait tout simplement à tout reprendre à ZERO, après avoir cerné les fonctionnalités d'une combobox et réfléchi très posément.
Je vais me contenter à ce stade de dire ceci : il ne faut pas "construire" une "combobox", mais travailler (couleurs, etc ...) sur celle existante.

EDIT : (et tu le sais bien). Le plus simple serait de ne pas du tout utiliser une combobox, mais systématiquement une listbox. En rappelant qu'une combobox n'est jamais rien d'autre qu'un ensemble constitué d'une zone de saisie et d'une listbox. Le reste (l'utilisation de cet ensemble) demande à être précédé d'une réflexion calme sur les fonctionnalités originelles (elles sont de la plus grande utilité). Elles ne doivent surtout pas être perdues et :
- ni troubler l'utilisateur (le survol lui-même est à remettre en cause)
- ni conduire le développeur à compliquer énormément son code

Maintenant -->> regarde le titre : .... "juste pour le fun" .....
Ce chemin-là restera du pur "fun"/exercice sans réelle efficacité.

[pijaku]

En rappelant qu'une combobox n'est jamais rien d'autre qu'un ensemble constitué d'une zone de saisie et d'une listbox. Le reste (l'utilisation de cet ensemble) demande à être précédé d'une réflexion calme sur les fonctionnalités originelles (elles sont de la plus grande utilité). Elles ne doivent surtout pas être perdues et :
- ni troubler l'utilisateur (le survol lui-même est à remettre en cause)
- ni conduire le développeur à compliquer énormément son code

Maintenant -->> regarde le titre : .... "juste pour le fun" .....
Ce chemin-là restera du pur "fun"/exercice sans réelle efficacité.

A mon tour alors de te dire que : tu as sacrément raison!

[patricktoulon]

re
Bonjour tous les deux

@unparia
oui la declararation de la classe dans le userform
tu me l'aurais dis directement on aurais perdu moins de temps

@pijaku

1. L'affichage de la dernière ligne (ligne 1000 dans ton exemple) est tronqué si la taille de police est inférieure à 10,
2. Le clic sur le "drop bouton" si la combo est ouverte devrait la refermer,
3. Normalement, le height d'une scrollbar verticale d'une combobox est plus petit que le height de son "frame", pas sur ta combofake,
4. Normalement, le clic sur une ligne amène comme résultat, dans le textbox, la valeur de sa première colonne, pas sur ta combofake,
5. Si le scroll H n'est pas affiché, il manque 2-3 points en hauteur des derniers labels,
6. Mêmes remarques que Jacques à propos du "rouge", du scroll et du clic sur n'importe quel contrôle,
7. Purement esthétique, je n'aime pas trop cette grosse flèche bleue...

1. cela peut facilement s'arranger
2. 3 mot dans le code de l'événement dans la classe et c'est réglé
3. purement une histoire de préférence
4. c'est le but de l'opération en fait avoir la donnée de la colonne
5. facilement rectifiable
6. les couleur sont paremetrables
7. tu peut choisir l'iconne que tu veux dans le lot de formes automatiques d'Excel

tu n'aime pas les bloks de code.......
la plupart du code c'est la construction le reste c'est que les évènements(clik,move)
je vais voir pour c'est petit defaut de hauteur

[pijaku]

Salut Patrick,

Tu bug??

[patricktoulon]

oui j'ai le clavier sans fil qui me fait ca des fois des que je touche une lettre il tape entrer et ca envois le message
c'est un clavier ultra plat il vaut une fortune et c'est de la daube

[pijaku]

c'est un clavier ultra plat il vaut une fortune et c'est de la daube

Yep. ça arrive...

Suite à nos remarques, doit-on attendre une nouvelle version ou l'on en reste là?