Listview et click sur un element d'une colonne

Version imprimable

Voir 40 message(s) de cette discussion en une page

05/03/2016, 10h42
patricktoulon

1 pièce(s) jointe(s)

re

si tes colonne sont pas de meme largeur il va te falloir utiliser un switch les select case entant trop pourri vilain

col=switch(x>xxx,16,x>xxx,15) etc.... les xxx déterminant la limite de chaque colonne
commence par le dernier jusqu au 1er

je me suis même amusé a ajouter un curseur qui se balade au dessus de la listview pour montrer la colonne
et dans le moose move en plus
LOL c'est un samedi matin normal :ptdr: ou un toulonnais triture les neurones d'un nordiste :aie::mouarf::ptdr:

regarde mon jolie petit curseur rouge c'est beau non?:ptdr::ptdr:

Pièce jointe 202961
05/03/2016, 10h48
Sebphyto

C jolie, ta petite barre rouge, il faudrait également, qu'il colorie le text ou la case afin de ne pas cliquer 2 fois sur le même num?
mais la largeur des col???tu fais comment pour le mettre à 80, que j'ai la même chose que toi.

Et crois-tu qu'il est possible d'affecter pour chaque clic, une macro??
seb
05/03/2016, 10h50
patricktoulon

re

bon je vais te faire un exemple avec des colonnes inégales comme ca tu comprendra mieux
05/03/2016, 10h53
Sebphyto

ok, mais le souci est que je voudrai réduire la listview, car elle prend trop de place, sans les barres de défilement
05/03/2016, 10h54
patricktoulon

re

on verra par la suite si on peut pas faire le calcul avec la scroll

Ok, ca roule
pour info je n'ai que 9 courses

Bon voilà mon code,
adapter au tien
impossible d'attribuer la largeur de 80

Code:

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
Private Sub CreationListView()
Dim oLv As ListView
Dim Wsheet As Worksheet
 
    Set Wsheet = ThisWorkbook.Sheets(2)
    Wsheet.Activate
    Set oLv = Wsheet.OLEObjects.Add(ClassType:="MSComctlLib.ListViewCtrl.2", _
        Link:=False, DisplayAsIcon:=False, Left:=100, Top:=100, Width:=300, Height:=100).Object
 
    With oLv
        .Name = "ListCust"
        .Left = .Parent.Columns("A").Left
        .Top = .Parent.Rows(3).Top
        .Height = 78
        .Width = 724
        .Visible = True
        .Gridlines = True
        .View = lvwReport
        .MousePointer = ccArrowQuestion
        .BackColor = &H80000000
        '.FullRowSelect = True
    End With
 
End Sub
Private Sub MisEnFormeEtRemplissageLV()
Dim i As Integer, c As Integer
Dim oLv As ListView
Dim oLi As ListItem
Dim Wsheet As Worksheet
Dim ch As ColumnHeader
    Set Wsheet = ThisWorkbook.Sheets(2)
    Set oLv = Wsheet.OLEObjects("ListCust").Object
    nbcourses = 9
   With Wsheet
 
    With oLv
        .ListItems.Clear
            With .ColumnHeaders
                        .Clear
            .Add , , "reunion"
            For i = 1 To nbcourses
                .Add , , "course" & i
 
            Next
        Debug.Print ligne
        End With
        .View = lvwReport
 
        For i = 1 To 4
            .ListItems.Add , "R" & i, "R" & i
 
            For c = 1 To 9
                .ListItems(i).ListSubItems.Add , , "R" & i & "C" & c
 
            Next c
        Next i
        'couleur text
        '.ListItems(1).ListSubItems(2).ForeColor = RGB(255, 255, 255)
 
        .Visible = False
        .Visible = True
    End With
 
    ActiveSheet.Shapes("ListCust").Select
 
    With Selection
        .Placement = xlFreeFloating
        .PrintObject = True
    End With
 
    ActiveWindow.SmallScroll Down:=-24
    ActiveWindow.SmallScroll Up:=24
End With
End Sub

edit:

Modif, j'avais oublié des choses
toujours le même problème de décalage, j'ai enlevé également les "80", pour la taille car ça ne passe pas....

bon voila j'ai un peu galéré mais c'est bon

a la creation j'agrandi a chaque fois la colonne
je memorise a chaque fois le left de chaque colonne en ajoutant dans l'item tablolargeur ce qui a déjà été fait + litem

ensuite dans le move ou mousedon dans le next il cherche l'index correspondant a x
tout simplement
pas d'erreur meme si les colonne sont de largeur différente
et tu n'a meme pas besoins de select case ou switch les largeur sont memorisées

Wagadougou!!!!

Code:

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
 
Private Sub ListView1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
  'on cherche l'index dans le tablolargeur enrtegistré dans le activate l'ors de la creation
  For c = 0 To 16
  If x > tablolargeur(c) Then col = c
  Next
    ind = IIf(Val((y - 21) / 21) = 0, 1, Val((y - 20) / 21))
    ind = IIf(ind > 4, 4, ind)
    ListView1.ListItems(ind).Selected = True
    MsgBox " vous avez cliqué sur  " & ListView1.ListItems(ListView1.SelectedItem.Index).ListSubItems(col).Text
        'ListView1.ListItems(1).Selected = True
End Sub
Private Sub ListView1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
 For c = 0 To 16
  If x > tablolargeur(c) Then col = c
  Next
     ind = IIf(Val((y - 21) / 21) = 0, 1, Val((y - 20) / 21))
    ind = IIf(ind > 4, 4, ind)
    ListView1.ListItems(ind).Selected = True
End Sub
Private Sub Worksheet_Activate()
nbcourses = 16
'----- remplissage ListView------------------------
    With ListView1
        ListView1.ListItems.Clear
        With .ColumnHeaders
                        .Clear
            .Add , , "reunion", 80 ' ici c'est la premiere colonne elle mesure 80
            tablolargeur(0) = 80
            For i = 1 To nbcourses
                .Add , , "course" & i, 80 + 5 * i ' ici j'ajoute 5 multiplié par i a chaque ajout de colonne
          'ce qui va nous donner une colonne de 85,90,95,100,105 etc......  OK????
            tablolargeur(i) = old + 80 + 5 * i - 5
            old = tablolargeur(i)
            Next
       Debug.Print Join(tablolargeur, ",")
 
        End With
        'on ajoute nos RX et les RxCY sur leur lignes respectives
        For i = 1 To 4
            .ListItems.Add , , "R" & i 'ajoute la reunion
            For c = 1 To nbcourses
                .ListItems(i).ListSubItems.Add , , "R" & i & "C" & c 'ajoute le RXCY
            Next
        Next
    End With
    '--------------------------------------------------
    'Spécifie l'affichage en mode "Détails"
    ListView1.View = lvwReport
    ListView1.ListItems(1).Selected = True
End Sub

test dans un fichier vierge

edit :
j'ai oublié
dim tablolargeur(16) en haut de module (variable global)

C casse noisette.....impossible de faire fonctionner ton code....:aie:
Je colle mousedown et mouseMove dans le code de la feuil
puis l'autre Windows activate je le mets ou???

Je crée ma list view avec ce code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Private Sub CreationListView()
Dim oLv As ListView
Dim Wsheet As Worksheet
 
    Set Wsheet = ThisWorkbook.Sheets(1)
    Wsheet.Activate
    Set oLv = Wsheet.OLEObjects.Add(ClassType:="MSComctlLib.ListViewCtrl.2", _
        Link:=False, DisplayAsIcon:=False, Left:=100, Top:=100, Width:=300, Height:=100).Object
 
    With oLv
        .Name = "ListV"
        .Left = .Parent.Columns("A").Left
        .Top = .Parent.Rows(3).Top
        .Height = 78
        .Width = 724
        .Visible = True
        .Gridlines = True
        .View = lvwReport
        .MousePointer = ccArrowQuestion
        .BackColor = &H80000000
        '.FullRowSelect = True
    End With
 
End Sub

05/03/2016, 12h31
patricktoulon

re

déjà ton code plante chez moi a ".name="listv"
d'autant plus que pourquoi private ???????

et pourquoi tiens tu a ce que ta listview soit créée dynamique ?????????
la rendre visible ou invisible serait pas plus simple
vu que tu a l'habitude de faire des app lourdes de beaucoup d'inutilité sans vouloir de chambrer c'est pas l'heure encore :ptdr:

je sais pas comment tu fonctionne mais c'est vraiment tordu ton truc
les choses sont si simples

le mieux donne moi les largeurs de tes colonnes souhaité

donc je reprends tu veux 4 ligne :r1 r2 r3 r4
sur 9 colonne (course de 1 a 9 c'est bien ca ???
donne moi les largeurs
allez aboule raoul !
05/03/2016, 12h53
Sebphyto

Citation:

et pourquoi tiens tu a ce que ta listview soit créée dynamique ?????????

peu importe, c'était juste pour m'entrainer

Citation:

donc je reprends tu veux 4 ligne :r1 r2 r3 r4
sur 9 colonne (course de 1 a 9 c'est bien ca ???
donne moi les largeurs

4 lignes oui
9 courses oui
largeur en fonction des entêtes "Course1"etc...
reprendre l'idée de ta barre rouge
et si possible, changement de couleur après click dans cellule listview...

et

Citation:

Et crois-tu qu'il est possible d'affecter pour chaque clic, une macro??

seb
05/03/2016, 12h59
patricktoulon

re

ben voyons t'a pas l'impression de d'abuser un peu la non ??

bon déjà fait moi plaisir si tu déclare tes variables ce que j'oublie de faire souvent mais toi tu déclare n'importe quoi

Code:

Dim oLv As MSComctlLib.ListView

déjà elle va se créer au moins
ensuite donc pour les largeur 80 suffisait pour les entête je vois pas pourquoi tu va chercher midi 14 heures
05/03/2016, 13h09
Sebphyto

Citation:

largeur 80 suffisait pour les entête je vois pas pourquoi tu va chercher midi 14 heures

oui parfaitement, ca me va

Citation:

bon déjà fait moi plaisir si tu déclare tes variables ce que j'oublie de faire souvent mais toi tu déclare n'importe quoi

Code:

Dim oLv As ListView

ça fonctionnait très bien... avec le code fourni plus haut

1 pièce(s) jointe(s)

bon il semblerait que se soit vraiment un controls a soucis

voila la creation fonctionne mais la list s'affiche mal je suis obligé de mettre en mode creation 2 fois pour qu'elle s'affiche correctement
demo
Pièce jointe 202979
code creation dans le activate du sheets

Code:

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
Dim tablolargeur(10)
Private Sub Worksheet_Activate()
Dim oLv As MSComctlLib.ListView, nbcourses
nbcourses = 9
Set oLv = ActiveSheet.OLEObjects.Add(ClassType:="MSComctlLib.ListViewCtrl.2", _
        Link:=False, DisplayAsIcon:=False, Left:=100, Top:=100, Width:=300, Height:=100).Object
 
    With oLv
        .View = lvwReport
        .Name = "ListV"
        .Left = .Parent.Columns("A").Left
        .Top = .Parent.Rows(3).Top
        .Height = 78
        .Width = 724
        .Visible = True
        .Gridlines = True
        .HoverSelection = True
        .MousePointer = ccArrowQuestion
        .BackColor = &H80000000
        .FullRowSelect = True
 
    With .ColumnHeaders
                        .Clear
            .Add , , "reunion", 80 ' ici c'est la premiere colonne elle mesure 80
            tablolargeur(0) = 80
            For i = 1 To nbcourses
                .Add , , "course" & i, 80  ' ici j'ajoute 5 multiplié par i a chaque ajout de colonne
          'ce qui va nous donner une colonne de 85,90,95,100,105 etc......  OK????
            tablolargeur(i) = old + 80 - 5
            old = tablolargeur(i)
            Next
       Debug.Print Join(tablolargeur, ",")
 
 
    End With
   For i = 1 To 4
            .ListItems.Add , , "R" & i 'ajoute la reunion
            For c = 1 To nbcourses
                .ListItems(i).ListSubItems.Add , , "R" & i & "C" & c 'ajoute le RXCY
            Next
        Next
 
 
  .Top = .Top + 100
.View = 3 'lvwReport
  End With
Application.ScreenUpdating = True
End Sub

05/03/2016, 13h26
Sebphyto

1 pièce(s) jointe(s)

désolé mais ca marche pas....
je lance la sub activate
Je vois bien la list se créer, mais après une erreur sans débugage

Pièce jointe 202980
05/03/2016, 13h33
patricktoulon

re

chez moi c'est le contraire c'est avec ta variable que ca me fait la même chose

ce qui appui ce que je dis depuis le début , en dynamique c'est un control ingérable car les librairies diffèrent selon les pc et system d'exploitation ou version d'Excel

a faire ca moi j'aurais pris une listbox beaucoup moins lourde pour un résultat visuel quasi identique mis a part les icons
après on peut le faire dans une frame avec boutons dynamique dans une classe

mais entres nous a quoi ca sert tout ce tointoin pour 4 lignes sur 9 colonnes

être utile ou pas être utile tel est la question shakespearienne:ptdr:
05/03/2016, 13h42
Sebphyto

Tu as raison Patrick, la listbox me parait également plus facile à gérer....donc....ListBox

Pour faire simple,
en gros ce que je souhaite est de consigner dedans le résultat de 4 tablo (tabR1 tabR2 , tabR3 et tabR4), dans ces tablo il y a les courses à jouer....
Par ex, pour aujourd"hui selon mes critères de sélection, en R1, il y avait seulement 4 courses à jouer, R2 5 courses, etc...
donc dans la ligne R1 du contrôle (listview ou listbox) je n'aurai que les 4 courses à jouer...

Après pour chaque courses il y a une analyse de celle-ci, d'où le click dans list pour appel procédure d'analyse de la course choisie....

Tu me demandes des explications, les voilà, alors après me dit pas que tu te perds dans ces explications...:ptdr::ptdr:
seb
05/03/2016, 13h47
patricktoulon

re

et oui je le dis
tu dis que tu veux 4 ligne sur 9 colonne
et maintenant tu dis que il y a que x course pour RX ou y courses pour Ry

c'est encore le meme soucis avec toi tu modifie ta trajectoire au fur et a mesure que tu trouve des solutions
un projet comme celui la s'établi a l'avance de A à Z étape par étape
je regarde pour une listebox

et comme tes connaissances en vb sont limitées tu ne vois pas la logique de ce que je te dis et encore moins l'appliquer

fait toi des planches avec paint même ca suffit
tu dessine ton app grossièrement
et après que tu a toutes tes planches tu créé en vrai chaque planches

1 pièce(s) jointe(s)

Merci du conseil, c une bonne façon de procéder

Citation:

tu dis que tu veux 4 ligne sur 9 colonne
et maintenant tu dis que il y a que x course pour RX ou y courses pour Ry

oui, mais dans ce fil de discussion, je ne pensais pas aller si loin dans les explications...Mais comme toi grand Patrick que tu est, tu pousses toujours plus loin..;)

Tiens voici à quoi ressemble mon interface (inspirée de celle que tu m'avais fait)...
Pièce jointe 202985
avec le code

Code:

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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
Sub interface()
Dim combo As OLEObject, ListB As OLEObject, Lab1 As OLEObject, Lab2 As OLEObject, Lab As OLEObject
Dim TextB As OLEObject, Lab4 As OLEObject, ListB2 As OLEObject
Dim e, tablocombo, i, r, fond
deleting
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    .Activate
    Set r = ActiveWindow.VisibleRange
        'on ajoute le fond d'ecran
        Set fond = .Shapes.AddShape(msoShapeRectangle, 0, 0, r.Width, r.Height)
        fond.Name = "acce"
        fond.Fill.UserPicture ("https://encrypted-tbn1.gstatic.com/images?q=tbn:ANd9GcSeY9rtmGyaS12lNOWYtfQjkB7rPFwkYQBqEfrPUN7JKAR_4UdTQg")
 
            ReDim tablocombo(4)
            tablocombo(0) = "Choisir une Réunion"
            tablocombo(1) = "Réunion 1"
            tablocombo(2) = "Réunion 2"
            tablocombo(3) = "Réunion 3"
            tablocombo(4) = "Réunion 4"
            'Aujourd'hui
            Set combo = .OLEObjects.Add("Forms.ComboBox.1")
            With combo
                .Name = "ComboBox1"
                .Object.ColumnCount = 1
                .Height = 20
                .Width = 116
                .Left = .Parent.Columns("C").Left 'Coin supérieur gauche aligné au niveau de la colonne "C"
                .Top = .Parent.Rows(10).Top 'Coin supérieur gauche aligné sur la ligne n°10
                .Object.Clear
                .Object.List = tablocombo
                .Object.ListIndex = 0
            End With
            Set Lab = .OLEObjects.Add("Forms.Label.1")
            With Lab
                .Name = "Label"
                .Object.Caption = "Choix Réunion"
                .Object.ForeColor = vbBlack
                .Object.BackColor = vbGreen
                .Height = 20
                .Object.Font.Size = .Height / 1.2
                .Width = 116
                .Left = .Parent.Columns("A").Left
                .Top = .Parent.Rows(10).Top
                .Object.TextAlign = 2
            End With
            Set TextB = .OLEObjects.Add("Forms.TextBox.1")
            With TextB
                .Name = "TextBox1"
                .Height = 20
                .Width = 70
                .Left = .Parent.Columns("B").Left 'Coin supérieur gauche aligné au niveau de la colonne "C"
                .Top = .Parent.Rows(5).Top 'Coin supérieur gauche aligné sur la ligne n°10
                .Object.Text = CStr(Date)
            End With
            Set Lab1 = .OLEObjects.Add("Forms.Label.1")
            With Lab1
                .Name = "Label1"
                .Object.Caption = "Date du jour"
                .Object.ForeColor = vbBlack
                .Object.BackColor = vbYellow
                .Height = 15
                .Object.Font.Size = .Height / 1.2
                .Width = 70
                .Left = .Parent.Columns("B").Left
                .Top = .Parent.Rows(4).Top
                .Object.TextAlign = 2
            End With
            Set Lab2 = .OLEObjects.Add("Forms.Label.1")
            With Lab2
                .Name = "Label2"
                .Object.Caption = "Courses jouables"
                .Object.ForeColor = vbYellow
                .Object.BackColor = ActiveWorkbook.Colors(9)
                .Height = 50
                .Object.Font.Size = .Height / 2.5
                .Width = 116
                .Left = .Parent.Columns("F").Left
                .Top = .Parent.Rows(5).Top
                .Object.TextAlign = 2
            End With
            Set ListB = .OLEObjects.Add("Forms.listbox.1")
            With ListB
                .Name = "ListBox1"
                .Object.ColumnCount = 2
                .Height = 15 * 10
                .Width = 250
                .Left = .Parent.Columns("E").Left 'Coin supérieur gauche aligné au niveau de la colonne "E"
                .Top = .Parent.Rows(10).Top 'Coin supérieur gauche aligné sur la ligne n°10
                .Object.Clear
                .Object.List = tablocombo
                .Object.ListIndex = 0
                '.Object.ColumnHeads = True
                '.RowSource = "Réunions"
            End With
 
            Set Lab3 = .OLEObjects.Add("Forms.Label.1")
        With Lab3
            .Name = "Label3"
            .Object.Caption = " Partants à jouer " & vbCrLf & " dans chaque courses "
            .Object.ForeColor = vbGreen
            .Object.BackColor = vbBlack
            .Height = 50
            .Object.Font.Size = .Width / 5
            .Width = 116
            .Left = .Parent.Columns("B").Left
            .Top = .Parent.Rows(22).Top
            .Object.TextAlign = 2
        End With
        Set ListB2 = .OLEObjects.Add("Forms.listbox.1")
            With ListB2
                .Name = "ListBox2"
                .Object.ColumnCount = 2
                .Height = 15 * 10
                .Width = 250
                .Left = .Parent.Columns("E").Left 'Coin supérieur gauche aligné au niveau de la colonne "E"
                .Top = .Parent.Rows(22).Top 'Coin supérieur gauche aligné sur la ligne n°10
                .Object.Clear
                .Object.List = tablocombo
                .Object.ListIndex = 0
            End With
'**********************************************************************************************************
            'Demain
            Set combo2 = .OLEObjects.Add("Forms.ComboBox.1")
            With combo2
                .Name = "ComboBox2"
                .Object.ColumnCount = 1
                .Height = 20
                .Width = 116
                .Left = .Parent.Columns("M").Left 'Coin supérieur gauche aligné au niveau de la colonne "C"
                .Top = .Parent.Rows(10).Top 'Coin supérieur gauche aligné sur la ligne n°10
                .Object.Clear
                .Object.List = tablocombo
                .Object.ListIndex = 0
            End With
            Set Lab4 = .OLEObjects.Add("Forms.Label.1")
            With Lab4
                .Name = "Label4"
                .Object.Caption = "Choix Réunion"
                .Object.ForeColor = vbBlack
                .Object.BackColor = vbGreen
                .Height = 20
                .Object.Font.Size = .Height / 1.2
                .Width = 116
                .Left = .Parent.Columns("K").Left
                .Top = .Parent.Rows(10).Top
                .Object.TextAlign = 2
            End With
            Set TextB2 = .OLEObjects.Add("Forms.TextBox.1")
            With TextB2
                .Name = "TextBox2"
                .Height = 20
                .Width = 70
                .Left = .Parent.Columns("L").Left 'Coin supérieur gauche aligné au niveau de la colonne "C"
                .Top = .Parent.Rows(5).Top 'Coin supérieur gauche aligné sur la ligne n°10
                .Object.Text = DateAdd("d", 1, Date)  'CStr(Date)
            End With
            Set Lab5 = .OLEObjects.Add("Forms.Label.1")
            With Lab5
                .Name = "Label5"
                .Object.Caption = "Date de demain"
                .Object.ForeColor = vbBlack
                .Object.BackColor = vbYellow
                .Height = 15
                .Object.Font.Size = .Height / 1.2
                .Width = 100
                .Left = .Parent.Columns("L").Left
                .Top = .Parent.Rows(4).Top
                .Object.TextAlign = 2
            End With
            Set Lab6 = .OLEObjects.Add("Forms.Label.1")
            With Lab6
                .Name = "Label6"
                .Object.Caption = "Courses jouables"
                .Object.ForeColor = vbYellow
                .Object.BackColor = ActiveWorkbook.Colors(9)
                .Height = 50
                .Object.Font.Size = .Height / 2.5
                .Width = 116
                .Left = .Parent.Columns("P").Left
                .Top = .Parent.Rows(5).Top
                .Object.TextAlign = 2
            End With
            Set ListB3 = .OLEObjects.Add("Forms.listbox.1")
            With ListB3
                .Name = "ListBox3"
                .Object.ColumnCount = 2
                .Height = 15 * 10
                .Width = 250
                .Left = .Parent.Columns("O").Left 'Coin supérieur gauche aligné au niveau de la colonne "E"
                .Top = .Parent.Rows(10).Top 'Coin supérieur gauche aligné sur la ligne n°10
                .Object.Clear
                .Object.List = tablocombo
                .Object.ListIndex = 0
                '.Object.ColumnHeads = True
                '.RowSource = "Réunions"
            End With
            Set Lab7 = .OLEObjects.Add("Forms.Label.1")
        With Lab7
            .Name = "Label7"
            .Object.Caption = " Partants à jouer " & vbCrLf & " dans chaque courses "
            .Object.ForeColor = vbGreen
            .Object.BackColor = vbBlack
            .Height = 50
            .Object.Font.Size = .Width / 5
            .Width = 116
            .Left = .Parent.Columns("L").Left
            .Top = .Parent.Rows(22).Top
            .Object.TextAlign = 2
        End With
        Set ListB4 = .OLEObjects.Add("Forms.listbox.1")
            With ListB4
                .Name = "ListBox4"
                .Object.ColumnCount = 2
                .Height = 15 * 10
                .Width = 250
                .Left = .Parent.Columns("O").Left 'Coin supérieur gauche aligné au niveau de la colonne "E"
                .Top = .Parent.Rows(22).Top 'Coin supérieur gauche aligné sur la ligne n°10
                .Object.Clear
                .Object.List = tablocombo
                .Object.ListIndex = 0
            End With
End With
Set combo = Nothing
Set TextB = Nothing
Set Lab = Nothing
Set Lab1 = Nothing
Set Lab2 = Nothing
Set Lab3 = Nothing
Set Lab4 = Nothing
Set ListB = Nothing
Set ListB2 = Nothing
Set combo2 = Nothing
Set TextB2 = Nothing
Set Lab4 = Nothing
Set Lab5 = Nothing
Set Lab6 = Nothing
Set Lab7 = Nothing
Set ListB3 = Nothing
Set ListB4 = Nothing
Application.ScreenUpdating = True
End Sub
Sub deleting()
    Dim shap: Application.DisplayAlerts = False
    Sheets(1).Cells(1, 1).Resize(4, 10) = ""
    For Each shap In Sheets(1).Shapes: shap.Delete: Next
    'ThisWorkbook.Save
End Sub

1 pièce(s) jointe(s)

bon même avec les listbox en dynamique c'est l'enfer avec ces propriétés
bref fait le en dur et puis c'est tout j'ai assez perdu du temps avec ca

.additem ne marche pas
.list()= tablo ne marche pas
la propriété n'ai pas reconnu
enfin bref no comment
top et fin

tiens pour preuve que les object dynamique dans le sheets sont vraiment pourri a mettre en place

cherche l'erreur dans le code y en a pas !!!
Code:

1 2 3 4 5 6 7 8 9 Sub test() Dim lst As OLEObject Dim tablo(4, 10) Set lst = ActiveSheet.OLEObjects.Add("Forms.ListBox.1", Left:=0, Top:=Cells(3, 1).Top, Width:=300 - 2, Height:=100) With lst .Name = "listV" .List() = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10) End With End Sub
Pièce jointe 202986

Re,
Ca fonctionne il faut juste rajouter .object devant .list ;)

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub test()
    Dim lst As OLEObject
    Dim tablo(4, 10)
    With Sheets("Feuil1")
    Set lst = .OLEObjects.Add("Forms.ListBox.1", Left:=0, Top:=Cells(3, 1).Top, Width:=300 - 2, Height:=100)
    With lst
        .Name = "listV"
        .Object.List = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
    End With
    End With
End Sub

Seb

Voir 40 message(s) de cette discussion en une page