Listview et click sur un element d'une colonne

Version imprimable

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

1 pièce(s) jointe(s)

tiens pour reprendre l'idée du xla mais sans xla et sans classe :ptdr:

hoh! le pauvre seb il va en perdre son latin :ptdr:
dans cet exemple je créé ma fausse listview nom pas avec des controlactivX label comme dans la classe du xla mais avec des shapes
et sur le ".onAction je dirige vers la sub avec pour argument la valeur diu text de la shapes
:ptdr::ptdr: et en couleur !!!!

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
Sub create()
    create_listview 4, 9, Sheets(1).Shapes("start")
End Sub
Sub create_listview(ligne, colonne, ctrl)
    Application.ScreenUpdating = False
    tops = ctrl.Top + ctrl.Height
    lefts = ctrl.Left
    With ActiveSheet.Shapes.AddShape(1, lefts, tops, 52, 17)
        .Name = "list"
        .TextFrame.Characters.Text = "Reunion"
        .Fill.ForeColor.RGB = RGB(255, 100, 100)
    .OnAction = ""
End With
    For i = 1 To colonne
        lefts = lefts + 52
        With ActiveSheet.Shapes.AddShape(1, lefts, tops, 52, 17)
            .Name = "listt" & i
            .TextFrame.Characters.Text = "course" & i
            .Fill.ForeColor.RGB = RGB(255, 100, 0)
        End With
    Next
    tops = tops + 17
    coul = 70
    For l = 1 To ligne
        coul = IIf(coul = 50, 100, 50)
        With ActiveSheet.Shapes.AddShape(1, ctrl.Left, tops, 52, 17)
            .Name = "list" & l
            .TextFrame.Characters.Text = "R" & l
            .Fill.ForeColor.RGB = RGB(245, 150, coul)
        End With
        lefts = ctrl.Left + 52
        For col = 1 To colonne
            With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, lefts, tops, 52, 17)
                 .Name = "listC" & col
                valeur = "R" & l & "C" & col
                .TextFrame.Characters.Text = valeur   '<-- nom de la zone de texte
                lefts = lefts + 52
            .Fill.ForeColor.RGB = RGB(255, 160, coul + 10)
            .OnAction = "'rxcx " & Chr(34) & valeur & "'" 'tout les bouton vont vers la meme sub
            End With
        Next
        tops = tops + 17
    Next
    Range("A1").Activate    '<-- permet de quitter la sélection de la zone de texte
End Sub
Sub rxcx(v)
MsgBox v
'ici tu fait ce que tu veux avec V !!!!
End Sub
Sub deletelistview()
'efface la fausse listview
    For Each sh In Sheets(1).Shapes
              If Left(sh.Name, 4) = "list" Then sh.Delete
        Next
End Sub

Pièce jointe 203117

07/03/2016, 13h39
Sebphyto

Salut Patrick,

Tu en fais exprès en faite....pour que j'en perds mon latin.....:mrgreen:
Mais il va falloir choisir!!!!!
Seb
07/03/2016, 17h55
patricktoulon

re

ben oui il faudra choisir mais c'est pas moi qui va le faire a ta place LOL

je te montre simplement diverses possibilités après le design de ton App c'est toi qui vois

si tu savais déjà tout ca tu aurais avancer plus vite dans l'élaboration de tes planches car quand on a les outils sa va toujours mieux hein....

j'attend la capture de ton écran d'accueil avec tes explications pour commencer

fait la simplement avec des shapes sans codes pour me simplifier la tache car tes explications souvent revellent d'autres question
alors soit bref et concis
07/03/2016, 20h27
Sebphyto

Re,

Citation:

ben oui il faudra choisir mais c'est pas moi qui va le faire a ta place LOL

Non c sur mais tes conseils sont précieux...

Citation:

je te montre simplement diverses possibilités après le design de ton App c'est toi qui vois

Oui et c cool, j'en apprends beaucoup

Citation:

si tu savais déjà tout ca tu aurais avancer plus vite dans l'élaboration de tes planches car quand on a les outils sa va toujours mieux hein....

c certain

Citation:

j'attend la capture de ton écran d'accueil avec tes explications pour commencer
fait la simplement avec des shapes sans codes pour me simplifier la tache car tes explications souvent révèlent d'autres question
alors soit bref et concis

Je vais essayer de ne pas te faire RALER ....:rouleau:

Bon, pour que l'on soit clair entre nous:
1 - tu veux une copie d'écran, d'une pseudo interface (avec label, combo, etc...)
2 - après il te faut, ce que je veux dans chaque contrôles (Array par ex)

On va commencer par çà, et j'essayerai de ne pas faire évoluer de trop le concept en cour de route....Lolllllll:ptdr::ptdr:
07/03/2016, 21h55
patricktoulon

re

oui c'est a peu près ca

que va faire cette page d'accueil ??

fait la avec tout ce que tu a apris
j'entends par la que ne fait pas comme d'habitude ""bon ca ne va pas on change tout ""

non réfléchi a ce que tu veux au possibilité que tu a et fait tes maquettes

pense a l'UC moins ton app sera lourde mieux c'est
07/03/2016, 22h09
Sebphyto

re,
Je viens d'essayer ton code pour créer "listview".....mais en vain

EDIT:
SI C BON C MOI LE BOULET.....:mouarf:

1 pièce(s) jointe(s)

Salut Patrick,

En espérant ne pas mettre trompé dans ce que tu veux...:?
Voilà l'idée de l'interface:
Pièce jointe 203289

Puis le code de celle-ci:

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
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("E").Left 'Coin supérieur gauche aligné au niveau de la colonne "C"
                .Top = .Parent.Rows(2).Top 'Coin supérieur gauche aligné sur la ligne n°2
                .Object.Clear
                .Object.List = tablocombo
                .Object.ListIndex = 0
            End With
            Set Lab1 = .OLEObjects.Add("Forms.Label.1")
            With Lab1
                .Name = "Label1"
                .Object.Caption = "Choix Réunion -->"
                .Object.ForeColor = vbBlack
                .Object.BackColor = vbGreen
                .Height = 20
                .Object.Font.Size = .Height / 1.2
                .Width = 116
                .Left = .Parent.Columns("C").Left
                .Top = .Parent.Rows(2).Top
                .Object.TextAlign = 2
            End With
            Set TextB = .OLEObjects.Add("Forms.TextBox.1")
            With TextB
                .Name = "TextBox1"
                .Height = 20
                .Width = 70
                .Left = .Parent.Columns("A").Left 'Coin supérieur gauche aligné au niveau de la colonne "C"
                .Top = .Parent.Rows(3).Top 'Coin supérieur gauche aligné sur la ligne n°10
                .Object.Text = CStr(Date)
            End With
            Set Lab2 = .OLEObjects.Add("Forms.Label.1")
            With Lab2
                .Name = "Label2"
                .Object.Caption = "Date du jour"
                .Object.ForeColor = vbBlack
                .Object.BackColor = vbYellow
                .Height = 15
                .Object.Font.Size = .Height / 1.2
                .Width = 70
                .Left = .Parent.Columns("A").Left
                .Top = .Parent.Rows(2).Top
                .Object.TextAlign = 2
            End With
 
            Set Lab3 = .OLEObjects.Add("Forms.Label.1")
        With Lab3
            .Name = "Label3"
            .Object.Caption = " Partants à jouer dans chaque courses "
            .Object.ForeColor = vbGreen
            .Object.BackColor = vbBlack
            .Height = 30
            .Object.Font.Size = .Width / 5
            .Width = 500
            .Left = .Parent.Columns("A").Left
            .Top = .Parent.Rows(17).Top
            .Object.TextAlign = 2
            .Object.SpecialEffect = 2
            .Object.Font.Italic = True
            .Object.Font.Bold = True
        End With
        Set Lab4 = .OLEObjects.Add("Forms.Label.1")
        With Lab4
            .Name = "start"
            .Object.Caption = " Courses jouables "
            .Object.ForeColor = &H0&
            .Object.BackColor = &HC0C0C0
            .Height = 20
            .Object.Font.Size = .Width / 5
            .Width = 150
            .Left = .Parent.Columns("D").Left
            .Top = .Parent.Rows(9).Top
            .Object.TextAlign = 2
            .Object.SpecialEffect = 1
            .Object.Font.Italic = True
            .Object.Font.Bold = True
            .Object.MousePointer = 14
        End With
 
'**********************************************************************************************************
        'Appel sub create listview
           create
        'Appel sub create_ListBox_resultat
        create_ListBox_resultat
End With
Set combo = Nothing
Set TextB = Nothing
Set Lab1 = Nothing
Set Lab2 = Nothing
Set Lab3 = Nothing
Set ListB = 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
Sub create()
    create_listview 4, 9, ActiveSheet.Shapes("start")
End Sub
Sub create_listview(ligne, colonne, ctrl)
    Application.ScreenUpdating = False
    tops = ctrl.Top + ctrl.Height
    lefts = ctrl.Left - 200
    With ActiveSheet.Shapes.AddShape(1, lefts, tops, 52, 17)
        .Name = "list"
        '.TextFrame.Characters.Text = "Reunion"
        .Fill.ForeColor.RGB = RGB(255, 100, 100)
    .OnAction = ""
End With
    For i = 1 To colonne
        lefts = lefts + 52
        With ActiveSheet.Shapes.AddShape(1, lefts, tops, 52, 17)
            .Name = "listt" & i
            .TextFrame.Characters.Text = "Course " & i
            .Fill.ForeColor.RGB = RGB(255, 100, 0)
        End With
    Next
    tops = tops + 17
    coul = 70
    For L = 1 To ligne
        coul = IIf(coul = 50, 100, 50)
        With ActiveSheet.Shapes.AddShape(1, ctrl.Left - 200, tops, 52, 17)
            .Name = "list" & L
            .TextFrame.Characters.Text = "R" & L
            .Fill.ForeColor.RGB = RGB(245, 150, coul)
        End With
        lefts = ctrl.Left - 148 '+ 52
        For col = 1 To colonne
            With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, lefts, tops, 52, 17)
                 .Name = "listC" & col
                valeur = "R" & L & "C" & col
                .TextFrame.Characters.Text = valeur   '<-- nom de la zone de texte
                lefts = lefts + 52
            .Fill.ForeColor.RGB = RGB(255, 160, coul + 10)
            .OnAction = "'rxcx " & Chr(34) & valeur & "'" 'tout les bouton vont vers la meme sub
            End With
        Next
        tops = tops + 17
    Next
    Range("A1").Activate    '<-- permet de quitter la sélection de la zone de texte
End Sub
Sub rxcx(v)
MsgBox v
'ici tu fait ce que tu veux avec V !!!!
End Sub
Sub create_ListBox_resultat()
    Dim lst As OLEObject
 
    With ActiveSheet
        Set lst = .OLEObjects.Add("Forms.ListBox.1", Left:=0, Top:=Cells(20, 1).Top, Width:=500, Height:=100)
        With lst
            .Name = "listV"
            '.Width = 10 * 51
            .Left = .Parent.Columns("A").Left
            .Top = .Parent.Rows(20).Top
            .Object.BackColor = &H8000000A
            .Object.ForeColor = &H80000008
            .Object.TextAlign = 2
            .Object.ColumnCount = 4
            .Object.ColumnWidths = "80;80;80;80"
 
            .Visible = False
            .Visible = True
        End With
        tops = lst.Parent.Rows(19).Top
        lefts = 0
        For i = 1 To 4
                '.AddShape(Type, Left, Top, Width, Height)
            With .Shapes.AddShape(1, lefts, tops, 125, 15)
                .Name = "listR" & i
                .TextFrame.Characters.Text = "Réunion " & i
                .TextFrame.Characters.Font.Bold = True
                .TextFrame.Characters.Font.Italic = True
                .TextFrame.Characters.Font.Size = 14
                .TextFrame.HorizontalAlignment = xlHAlignCenter
                .TextFrame.VerticalAlignment = xlVAlignCenter
                .Fill.ForeColor.RGB = RGB(160, 160, 160)
            End With
            lefts = lefts + 125
        Next i
    End With
End Sub

Est-ce que tu souhaité que je te fournisse?
Seb

09/03/2016, 11h01
patricktoulon

re

Bonjour Seb
Oui bon ben moi je passerait du choix de la réunion a la liste des chevaux a jouer en 1 coup
puisque visiblement les réunions jouable sont avec critères donc les critères sont en mémoire out ils sont déjà disponibles quelque part d'après ce que je comprends de ton fonctionnement

et même si les critères ne sont pas disponibles et que tu sélectionne tes course a la main dans la fausse listeviw

je ferait un menu contextuel comme je t'ai montré en cascade et il y aurait les sub item course 1 ,course2, etc dans des item réunion
et je vire tout le reste !!!!!!
09/03/2016, 11h45
Sebphyto

Salut Patrick,

Citation:

Oui bon ben moi je passerait du choix de la réunion a la liste des chevaux a jouer en 1 coup

Oui j'y ai bien pensé, mais il y a certains jours des réunions étrangères, donc cela ne m'intéressent pas, c pour çà que j'avais choisi cette option.
Passer de réunions aux chevaux directement, j'ai peur pour la rapidité d'éxécution.

Citation:

puisque visiblement les réunions jouable sont avec critères donc les critères sont en mémoire

Dans une sub avec des conditions (if, case,...)

Citation:

menu contextuel comme je t'ai montré en cascade

J'aime bien cette option, ce qu'il faut pensé c que ne soit apparant que les courses jouables .

Donc je réexplique pour que l'on soit sur la même longueur d'ondes:
1- ouverture du classeur --> récup lien des 4 réunions du jour
2 - sélection réunion (R1 par ex) ---> il en ressort X courses jouables (transférer dans tabloR1 composé comme çà tabloR1(0,0) = N°course prix lien)
3 - consignation dans feuil des courses R1 avec couleur rouge ou vert selon jouabilité
4 - Selon TabloR1, pour chaque courses sélection avec critères, des chevaux à jouer.
5 - consignation dans une autre feuil des chevaux avec code couleur (5 niveaux de couleurs diff) selon jouabilité.

Voilà l'idée

Seb
09/03/2016, 12h00
patricktoulon

re

alors pour moi c'est encore plus simple

Citation:

Donc je réexplique pour que l'on soit sur la même longueur d'ondes:
1- ouverture du classeur --> récup lien des 4 réunions du jour
2 - sélection réunion (R1 par ex) ---> il en ressort X courses jouables (transférer dans tabloR1 composé comme çà tabloR1(0,0) = N°course prix lien)
3 - consignation dans feuil des courses R1 avec couleur rouge ou vert selon jouabilité
4 - Selon TabloR1, pour chaque courses sélection avec critères, des chevaux à jouer.
5 - consignation dans une autre feuil des chevaux avec code couleur (5 niveaux de couleurs diff) selon jouabilité.

Voilà l'idée

un simple bouton point barre
si tu a consigné dans tablor1 les course jouables et pour les r2,r3,r4 pareil
pourquoi ne pas faire partir tout ca directement dans la liste finale ?????
on a encore une fois l'exemple que tu ne vois pas la finalité tu passe par la gauche ,la droite ,le milieu, etc... pour choisir le centre
si tu a tout consigné dans tabr(X) la macro du clic sur la listview doit être intégré dans ce bouton

apres je ne connais pas tout tes critères ni comment tu les conçoit et les interprète mais le principe est la
09/03/2016, 13h18
Sebphyto

re,

Citation:

si tu a consigné dans tablor1 les course jouables et pour les r2,r3,r4 pareil

oui respectivement

Citation:

pourquoi ne pas faire partir tout ca directement dans la liste finale ?????

oui, certes, mais il me faut un moyen rapide de les consulter sans devoir passer par chaque feuil

Citation:

si tu a tout consigné dans tabr(X) la macro du clic sur la listview doit être intégré dans ce bouton

exactement, comme çà j'aurais le visu sur chaque courses à jouer.

Citation:

apres je ne connais pas tout tes critères ni comment tu les conçoit et les interprète mais le principe est la

Le principal est d'avoir le résultat final (courses à jouer avec les chevaux à jouer pour chaque courses).

Seb
10/03/2016, 20h46
Sebphyto

Salut Patrick,

Bon ton idée d'un seul bouton, me convient partiellement, car cela implique d'importer toutes les réunions selon critères , toutes les courses selon critères....mais comme mon idée de départ je veux avoir la main sur les réunions que je veux (hors étrangères)....

Toi tu veux tout faire d'un coup--- passer de réunion directement à chevaux à jouer ----mais pour les courses étrangères????

J'ai pensé un tablo regroupant tous les hippo de France, mais il y en n'a quelques uns (250 en tout) et cela alourdira le code

Le problème est les "COURSES ETRANGERES"

Soit je reviens à:
- à l'ouverture du classeur, récup réunions-->c bon
- sélection d'une réunion choisie (française)--> via combo
- récup des courses jouables--> visible dans listbox
- click sur listbox de la course sélectionnée
- récup des partants à jouer selon mes critères--> visible dans listbox également
soit tablo hippo

Je sais que cela peut-être lourd, mais il n'y a que comme ça que j'ai la main sur tout....

J'apprécie tes conseils, si tu en n'a d'autre je suis open...

Seb
10/03/2016, 20h55
patricktoulon

re

ok si tu le dis ma fois je ne peut pas juger je n'ai pas le fichier sous les yeux

je suis en train de terminer le programmateur pour le moment mais j'ai aussi mon projet d'éditeur wysiwyg a continuer
10/03/2016, 20h59
Sebphyto

Re,
Je viens d'éditer mon post précédent..

Citation:

ok si tu le dis ma fois je ne peut pas juger je n'ai pas le fichier sous les yeux

c sur, sans fichier c pas simple

Citation:

je suis en train de terminer le programmateur pour le moment

C cool, et je t'en remercie fortement

Citation:

mon projet d'éditeur wysiwyg a continuer

oui il est important de penser à soi, par moment....;)
Seb

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