Discussion :

[mjpmjp]

bonjour,

Lien vers : Form GRAPHIQUE, Liste Onglet dynamique

Liste Multi-Colonne et ScrollBar "externe"

[mjpmjp]

bonjour,

en premier, puisqu'il est question de liste, je "remplis" ces listes

les "Data" sont dans des feuilles (sheets), classés dans plusieurs colonnes qui forment un tableau avec 3 lignes de titre
le but, ici, est de définir l'espace de travail (sans titre) que je nomme "PlageRange" et dans cet espace, sélectionner uniquement les colonnes qui me sont utiles pour reconstituer (en mémoire) un tableau virtuel (array) que je nomme "TabOnglet" --> "Tab" pour tableau...

voila le schéma


les "Data" de ce nouveau tableau vont être "travaillés" pour constituer un autre tableau virtuel nommé "TabList" qui est destiné à "remplir" la liste

ListOngletToForm

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
 
Public Function ListOngletToForm(ByVal OngletName As String, ByVal ObjLblFichierNum As Object)
    '----- # v3
    If OngletName = "" Then Exit Function
    n2 = -1
    'derniere ligne Onglet
    ListLigneDeFin = ListFin(OngletName, ListColonTitre & ListLigneDebut)
    '-----
    'copier les colonnes {1,2,10,11,12,13,14,15} dans TabOnglet...attention ne pas utiliser ".value" de range
    Set PlageRange = Sheets(OngletName).Range(ListColonTitre & ListLigneDebut - 1 & ":" & ListColonFin & ListLigneDeFin)
    TabOnglet = Application.Index(PlageRange, Evaluate("Row(1:" & PlageRange.Rows.Count & ")"), [{1,2,10,11,12,13,14,15}])
    '-----
    'Partie CD expend
    Dim TabTitre() As Variant
    Dim TabAlias() As Variant
    Dim TabTaille() As Variant
 
    For n = 1 To UBound(TabOnglet)
    '## cette partie a été réduite (trop spécifique) pour simplifiée l'exemple ##
        'cd1
        n2 = n2 + 1
        ReDim Preserve TabTitre(n2): TabTitre(n2) = TabOnglet(n, 1) 'nom
        ReDim Preserve TabAlias(n2): TabAlias(n2) = TabOnglet(n, 2) 'alias
        ReDim Preserve TabTaille(n2): TabTaille(n2) = Format(TabOnglet(n, 3), "0######") 'taille
    Next n
    '-----
    'creer TabList et redimentionner
    Dim TabList() As Variant: ReDim TabList(1 To UBound(TabTitre), 0 To 9)
    Dim TabTRI() As Variant: ReDim TabTRI(1 To UBound(TabTitre), 0 To 2)
    'creer table clé et redimentionner comme TabList,1
    Dim TabCLE() As String: ReDim TabCLE(1 To UBound(TabTRI, 1))
    'creer table index et redimentionner comme TabList,1
    Dim TabIND() As Long: ReDim TabIND(1 To UBound(TabTRI, 1))
 
    For n = 1 To UBound(TabTRI) 'nombre de ligne (row)
        TabTRI(n, 0) = TabTitre(n) 'nom
        TabTRI(n, 1) = TabAlias(n) 'alias
        TabTRI(n, 2) = TabTaille(n) 'taille
        'concaténer toutes les colonnes sur une ligne -> clé
        For n2 = 0 To UBound(TabTRI, 2) 'nombre de dim (col)
            TabCLE(n) = TabCLE(n) & TabTRI(n, n2)
        Next n2
        TabIND(n) = n
    Next n
    '-----
    'appel procedure de tri
     Call TriQuickSort(TabCLE(), TabIND(), 1, UBound(TabCLE))
    '-----
    'Construction TabList
    For n = 1 To UBound(TabCLE) 'nombre de ligne (row)
        'For n2 = 1 To UBound(TabTRI, 2) 'nombre de dim (col)
            'Tab...(n, n2) = TabTRI(TabIND(n), n2)
        'Next n2
        If TabTRI(TabIND(n), 1) = "" Then TabTRI(TabIND(n), 1) = " "
        TabList(n, 0) = TabTRI(TabIND(n), 2)    'taille
        TabList(n, 1) = TabTRI(TabIND(n), 0)    'titre
        TabList(n, 2) = " "                     '.avi
        TabList(n, 3) = n                       'ligne onglet
        TabList(n, 4) = TabTRI(TabIND(n), 1)    'alias
        TabList(n, 5) = " "                     'origine
        TabList(n, 6) = " "                     'ligne origine
        TabList(n, 7) = " "                     'conforme,renomer,suprimer,copier,manque
        TabList(n, 8) = " "                     'Bis
        TabList(n, 9) = " "                     '
    Next n
    '-----
    ObjLblFichierNum.Caption = UBound(TabList)
    '-----
    ListOngletToForm = TabList
End Function

tout ce qui concerne le tri, n'est pas de moi (notamment "TriQuickSort") et aussi les codes "périphériques"

'concaténer toutes les colonnes sur une ligne -> clé

c'est volontiers que je "rends à César ce qui est à César", le problème c'est que je ne sais plus à quel César j'ai piqué le code ...

TriQuickSort

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
 
Public Sub TriQuickSort(TabCLE() As String, TabIND() As Long, gauc, droi)
    'Trier AZ avec methode Quick sort
    'annoté JP
    'ref milieu de List
    'TabCLE(g) haut de List
    'TabCLE(d) bas de List
 
   Ref = TabCLE((gauc + droi) \ 2)
   g = gauc
   d = droi
   Do
      Do While TabCLE(g) < Ref: g = g + 1: Loop 'tant que TabCLE(g) < ref
      Do While Ref < TabCLE(d): d = d - 1: Loop 'tant que    ref < TabCLE(d)
        If g <= d Then
           temp = TabCLE(g): TabCLE(g) = TabCLE(d): TabCLE(d) = temp
           temp = TabIND(g): TabIND(g) = TabIND(d): TabIND(d) = temp
           g = g + 1: d = d - 1
        End If
    Loop While g <= d
    If g < droi Then Call TriQuickSort(TabCLE, TabIND, g, droi)
    If gauc < d Then Call TriQuickSort(TabCLE, TabIND, gauc, d)
End Sub

pour l'instant, j'ai donc transféré les "Data" d'un Onglet vers un Tableau virtuel qui représente (en mémoire) ma Liste
par la suite nous allons voir la Liste "physique"

[mjpmjp]

bonjour,

j'avais besoin de voir plusieurs listes qui n'avaient pas le même nombre de colonnes
après de nombreux essais, j'ai opté pour une liste unique avec le plus grand nombre de colonnes (10)

Code :

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

1
2
 
    Me.LbxFrm1.ColumnCount = 10

que je dimensionne

Code :

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

1
2
 
    Me.LbxFrm1.ColumnWidths = "44 pt;340 pt;26 pt;20 pt;56 pt;36 pt;38 pt;36 pt;38 pt;10 pt"

et que je modifie

Code :

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

1
2
 
    Me.LbxFrm1.ColumnWidths = "44 pt;340 pt;26 pt;20 pt;2 pt;36 pt;20 pt;42 pt;42 pt;2 pt"

pour "remplir" cette Liste Multi-Colonne avec un Tableau, il existe plusieurs méthodes,

Lien vers : Alimentation d'un listbox multi colonnes à partir d'une table de dim variable (n, p)

mais, ici, le propos est le Graphisme et ses contraintes
par exemple : dans une ListBox on ne peut pas "colorier" la scrollbar, il n'y a pas de ligne bleue qui suit le curseur,...

[mjpmjp]

bonjour,

Un Monde d Illusion

avec un contrôle "MultiPage" plusieurs "boutons" commandent autant de pages et de liste dans ces pages
avec un contrôle "TabStrip" les boutons restent mais les pages ne sont plus là, seules restent les listes

l'Illusion consiste en plusieurs Bouton --> "Btn..." pour une "Liste UNIQUE de 33 Lignes" sans ScrollBar (ne cherchez pas, il n'y a pas de ScrollBar=False)

pendant que vous calculez comment mettre une liste de 20000 lignes dans une liste de 33 lignes, je vous explique la ScrollBar "externe"


dans le VBA du form, l’événement "initialize"

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
Private Sub UserForm_Initialize()
    'initialise les variables
    Call SystemINIT_VariableSystem
    '######################################## FORM
    '...
    '######################################## FRAME
    '---------------------------------------- FRAME,1,Analyse
    'masque la scrollbar
    Me.SbrFrm1ScrollBar.Visible = False
    Me.ImgFrm1ScrollBarFond.Visible = False
End Sub

on masque
le contrôle ScrollBar --> "Sbr..."
le contrôle Image --> "Img..." , image de fond

pour les valeurs du ScrollBar

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
        '----- ScrollBar
        Me.SbrFrm1ScrollBar.Value = 1
        'controle le nombre de ligne
        If UBound(TabListServeur) < 33 Then
            Me.SbrFrm1ScrollBar.Visible = False
            Me.ImgFrm1ScrollBarFond.Visible = False
        Else
            Me.SbrFrm1ScrollBar.Visible = True
            Me.ImgFrm1ScrollBarFond.Visible = True
            Me.SbrFrm1ScrollBar.Max = UBound(TabListServeur) - 33
        End If
        '----

ce code se trouve dans le code "Action" du Bouton

chaque Bouton qui appelle une liste est correspond à un tableau virtuel --> "Tab..."
si le tableau dépasse les 33 lignes de la "liste Unique" on affiche le contrôle ScrollBar et l'image de fond qui va s'accorder avec l'image de fond de la frame
la valeur "Max" du contrôle est le nombre de ligne du tableau virtuel MOINS les 33 lignes

Code :

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

1
2
 
 Me.SbrFrm1ScrollBar.Max = UBound(TabListServeur) - 33

le contrôle ScrollBar est en place, visible et "armé" (valeurs), il n'attend plus que les ordres...:weird:

événement du ScrollBar

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
 
'---------------------------------------------------------------------------------------------------------------------- FRAME,1,Analyse,SbrFrm1ScrollBar
Private Sub SbrFrm1ScrollBar_Change()
    Call Frm1ScrollBar_Action
End Sub
Private Sub SbrFrm1ScrollBar_Scroll()
    Call Frm1ScrollBar_Action
End Sub
Private Sub Frm1ScrollBar_Action()
    Select Case EcranActuel
        Case "Serveur"
            Me.LbxFrm1Ecran.List = ListToListEcran(TabListServeur, Me.SbrFrm1ScrollBar.Value, "Serveur")
        Case "Disque"
            Me.LbxFrm1Ecran.List = ListToListEcran(TabListDisque, Me.SbrFrm1ScrollBar.Value, "Disque")
        Case "List"
            Me.LbxFrm1Ecran.List = ListToListEcran(TabListOnglet, Me.SbrFrm1ScrollBar.Value, "List")
        Case "Resultat"
            Me.LbxFrm1Ecran.List = ListToListEcran(TabListResultat, Me.SbrFrm1ScrollBar.Value, "Resultat")
    End Select
End Sub

comme toujours, il y a des 'trucs" en trop (Serveur,Disque,...) ne pas en tenir compte, TOUT le reste est bon

l'exemple à retenir

Code :

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

1
2
 
 Me.LbxFrm1Ecran.List = ListToListEcran(TabListServeur, Me.SbrFrm1ScrollBar.Value, "Serveur")

ListToListEcran est une "Function" ce qui implique qu'elle retourne (quelle incarne) quelque chose --> un tableau --> TabListEcran

donc, la Liste --> "Lbx..." est "remplie" par ce tableau

Me.SbrFrm1ScrollBar.Value --> c'est la valeur du ScrollBar
quand on déplace le curseur du ScrollBar, on déplace sa valeur de 1 à Max (voir plus haut)

le mécanisme du ScrollBar "externe" étant lié à celui de la "Liste Unique", on arrive maintenant au mécanisme de l’illusion

[mjpmjp]

bonjour,

voila comment schématiser au plus simple le mécanisme d'une "Liste Ecran" (unique) de 33 Lignes, dans laquelle on fait glisser un Tableau de 20000 Lignes


les "Tab1" et "Tab2" sont là pour illustrer le traitement des "Data" qui peuvent provenir de plusieurs sources différentes pour au final "remplir" le Tableau dédié à Cette "Liste Ecran"

déclaration publique

Code :

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

1
2
3
4
 
Public TabListEcran(1 To 34, 0 To 9) As Variant
Public EcranActuel As String
Public EcranLigneMax As Single

ListToListEcran

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
 
Public Function ListToListEcran(ByVal TabData As Variant, n As Single, Origine As String)
    'pour effacer TabListEcran -> appeler EffaceTabListEcran() en dehors de la fonction
    '----
    'formate le nom de l'écran actuel
    EcranActuel = UCase(Left(Origine, 1)) & LCase(Right(Origine, Len(Origine) - 1))
    'controle le nombre de ligne
    If UBound(TabData) < 33 Then
        LigneMax = UBound(TabData) - 1
    Else
        LigneMax = 33
    End If
    EcranLigneMax = LigneMax + 1
    '----- transfer de 34 lignes pour la liste LbxFrm1Ecran
    For n = n To n + LigneMax
        n3 = n3 + 1
        For n2 = 0 To 9
            TabListEcran(n3, n2) = TabData(n, n2)
        Next n2
    Next n
    '----
    ListToListEcran = TabListEcran
End Function

EffaceTabListEcran

Code :

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

1
2
3
4
5
6
7
8
 
Public Sub EffaceTabListEcran()
    For n = 1 To 34
        For n2 = 0 To 9
            TabListEcran(n, n2) = " "
        Next n2
    Next n
End Sub

le mécanisme de la ligne bleue a pour cette Liste, exécute un test --> si Ecran est OFF --> on sort (pour ne pas afficher une ligne bleue sur un écran vide)

Code :

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

1
2
3
4
5
6
7
 
'---------------------------------------------------------------------------------------------------------------------- FRAME,1,Analyse,LbxEcran
Private Sub LbxFrm1Ecran_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If EcranOFF = True Then Exit Sub
    Ligne = Int(Y / (LbxFrm1Ecran.Font.Size * 1.182))
    If Ligne > -1 And Ligne < EcranLigneMax Then Me.LbxFrm1Ecran.Selected(Ligne) = True
End Sub

le rappelle que dans ce contexte, on utilise pas l’événement "Click" mais "MouseDown"

Code :

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

1
2
3
4
 
Private Sub LbxFrm1Ecran_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    '...
End Sub

voila cette fois c'est terminé...amusez vous bien

@+JP

[mjpmjp]

bonjour,

voila un complément d'information : positionnement des contrôles image et Label décalé sur un nouvel écran 3840x2160

@+JP

[pijaku]

Bonjour mjpmjp,

Il y aurait une autre manière de procéder, en utilisant le RowSource de ta ListBox.
Je ne parle bien entendu pas de graphisme ici, mais juste du remplissage de ta liste.

En fait, au clic sur un bouton, tu remplis ta liste initiale (grâce à RowSource et ColumnWidths et ColumnCount), puis, au clic sur ton ScrollBar, tu changes ce RowSource.

Je t'ai "bricolé" un exemple "vite fait" pour que tu vois ce que cela donne.

1- dans un nouveau classeur, remplir les trois feuilles : "Feuil1", "Feuil2" et "Feuil3" grâce à cette procédure (dans un module standard) :

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
Sub Rempli()
'remplit_Feuilles Nbre de lignes, Nbre de colonnes, nom des feuilles
'j'ai choisit arbitrairement le Range("A" à "T") comme RowSource de ma ListBox d'ou les 20 colonnes :
    Remplit_Feuilles 40, 20, "Feuil1", "Feuil2", "Feuil3"
End Sub
 
Sub Remplit_Feuilles(N&, NbCol&, ParamArray Feuilles() As Variant)
Dim F As Variant, TB()
Dim i&, j&
 
    Application.ScreenUpdating = False
    For Each F In Feuilles
        Sheets(F).Cells.Clear
        ReDim TB(1 To N, 1 To NbCol)
        For i = 1 To N
            For j = 1 To NbCol
                TB(i, j) = F & " " & Chr(64 + j) & i
            Next j
        Next i
        Sheets(F).Range("A1").Resize(N, NbCol) = TB
    Next
    Application.ScreenUpdating = True
End Sub

2- Insérer un UserForm avec dedans :
- 3 boutons de commande : CommandButton1, CommandButton2, CommandButton3
- une ListBox : ListBox1
- un scrollbar : ScrollBar1
Place les comme ceci :
Pièce jointe 274517
Oui, je sais c'est moche. L'intérêt ici réside uniquement dans le code...

3- dans le module de l'userform, ce code :

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
Option Explicit
 
'ici, on place dans des constantes les ColumnWidths différents
'les colonnes à 0 ne seront pas affichées
Const ColWidthsBtn1 As String = "50;50;0;0;0;0;0;50;50;100;0;0;0;0;0;0;50"
Const ColWidthsBtn2 As String = "50;50;50;0;50;0;0;0;0;0;50;50;50;0;0;0;50;0;0;50"
Const ColWidthsBtn3 As String = "0;0;0;0;0;0;0;50;50;100;0;50;50;0;0;0;0;50;50;0"
 
'nombre de lignes affichées
Const NbLig As Long = 20
 
'variables utiles à plusieurs procédures
Private Prem_Lig As Long
Private FeuilleEnCours As String
 
Private Sub CommandButton1_Click()
'le RowSource viendra de la feuille Feuil1
    FeuilleEnCours = "Feuil1"
'le columnWidths est celui de la constante ColWidthsBtn1
    Remplit_Liste ColWidthsBtn1
'réglage du Max et du Min du ScrollBar en fonction de la feuille
    'le Max est le nombre de lignes total de la feuille moins le nombre de lignes affichées
    Me.ScrollBar1.Max = derlig_reelle(Sheets(FeuilleEnCours).Cells) - NbLig
    'le Min est 1, ici la première ligne remplit, n'ayant pas d'entêtes
    Me.ScrollBar1.Min = 1
End Sub
 
Private Sub CommandButton2_Click()
    FeuilleEnCours = "Feuil2"
    Remplit_Liste ColWidthsBtn2
    Me.ScrollBar1.Max = derlig_reelle(Sheets(FeuilleEnCours).Cells) - NbLig
    Me.ScrollBar1.Min = 1
End Sub
 
Private Sub CommandButton3_Click()
    FeuilleEnCours = "Feuil3"
    Remplit_Liste ColWidthsBtn3
    Me.ScrollBar1.Max = derlig_reelle(Sheets(FeuilleEnCours).Cells) - NbLig
    Me.ScrollBar1.Min = 1
End Sub
 
Private Sub ScrollBar1_Change()
'si pas encore cliqué sur un bouton, FeuilleEnCours = "" ==> on sort
    If FeuilleEnCours = "" Then Exit Sub
'réglage de la première ligne du RowSource
    Prem_Lig = ScrollBar1
'application du RowSource : première ligne et première ligne + Nb lignes dans le Range("A" à "T") de la feuille en cours
'et donc affichage de 20 lignes seulement
    Me.ListBox1.RowSource = FeuilleEnCours & "!" & Sheets(FeuilleEnCours).Range("A" & Prem_Lig & ":T" & Prem_Lig + NbLig).Address
End Sub
 
Private Sub UserForm_Initialize()
'pas très utile...
    Me.Move Me.Left, Me.Top, 800, 400
End Sub
 
Private Sub Remplit_Liste(CoWidths As String)
'procédure initiale de remplissage de la liste en fonction du clic sur un bouton
Dim NC As Long
 
    NC = UBound(Split(CoWidths, ";")) + 1
    With Me.ListBox1
        .RowSource = FeuilleEnCours & "!" & Sheets(FeuilleEnCours).Range("A1:T" & NbLig).Address
        .ColumnCount = NC
        .ColumnWidths = CoWidths
    End With
End Sub
 
Private Function derlig_reelle(plage As Range) As Long
'fonction de calcul de dernière ligne d'un Range
   If WorksheetFunction.CountA(plage) = 0 Then derlig_reelle = 1: Exit Function
   derlig_reelle = plage.Find("*", , , , , xlPrevious).Row
End Function

[mjpmjp]

bonjour pijaku,

merci pour ton intérêt à cette discussion,
si j'ai bien compris, tu fais glisser la plage de cellule de référence à rowsource --> c'est le principe de ce mécanisme

c'est une solution à noter quelque part --> j'ai vu qu'il y avait un petit jeu de pousse --> j'ai poussé +1

je travaille ICI avec du "virtuel" pour au final tout effacer après avoir traiter des fichiers

@+JP

[pijaku]

J'ai fait cette démo pour deux raisons :
1- oui, comme tu dis, on fait "glisser" le Range du RowSource
2-

j'ai opté pour une liste unique avec le plus grand nombre de colonnes (10)

n'est pas vrai dans le cas d'alimentation par RowSource...
Voilà

[mjpmjp]

bonjour,

j'ai opté pour une liste unique avec le plus grand nombre de colonnes (10)

le plus grand nombre de colonnes --> de toutes mes listes --> des liste avec 7,8 ou 10 colonnes --> alors 10

@+JP