Listview et click sur élément d'une des colonnes

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

J'ai un userform contenant un listview de 15 colonnes (avec des tailles de colonne différentes)
Je cherche à identifier via click droit la valeur de l'élément cliqué ou a minima la référence de la colonne auquel appartient l'élément cliqué.
Je comptais me baser sur les coordonnées x,y de l'évènement ListView1_MouseDown en les comparant aux références ColumnHeaders(a).Left des colonnes du Listview.

Le hic, les coordonnées x,y renvoyées par rapport à l'événement ListView1_MouseDown sont incohérentes par rapport aux références de colonne.

Dans la textbox du userform, j'ai recensé la référence de fin de colonne (en additionnant ColumnHeader.Left et ColumnHeader.Width) et dans l'évènement ListView1_MouseDown, j'ai juste demandé une msgbox indiquant les coordonnées x,y.
Vous remarquerez qu'entre la position du curseur de la souris, les coordonnées x,y remontées par la msgbox et les références de colonnes de la textbox, il y a incohérence.

Je clique sur un élément de la colonne 8 de juin (entre 520 et 565) alors que la coordonnée x du curseur est à 704

Pièce jointe 285887
Désolé pour la photo de l'écran de PC mais je n'arrivais pas à avoir le cursus visible sinon :mouarf:

Je vous joins mon code sur l'initialize du userform

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
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)
 
MsgBox ("En Pixels - X : " & x & " - Y : " & y)
 
End Sub
 
 
Private Sub UserForm_Initialize()
 
'Dim TabPositionLeftColonneListView(14, 1)
Dim ValeurLeft As Single
Dim ValeurWidth As Single
Dim ValeurRight As Single
 
'-----------------------------------------------------------------
'Création et complétude la listview
'-----------------------------------------------------------------
With ListView1
    'Définit le nombre de colonnes et Entêtes
    With .ColumnHeaders
        'Supprime les anciens entêtes
        .Clear
        'Ajoute 15 colonnes en spécifiant le nom de l'entête
        'et la largeur des colonnes
        .Add , , "NUM", 0
        .Add , , "Indicateur n°1 [Obj : 20% - Socle : 17%]", 250
        .Add , , "2016", 45
        .Add , , "Janv", 45
        .Add , , "Fev", 45
        .Add , , "Mars", 45
        .Add , , "Avril", 45
        .Add , , "Mai", 45
        .Add , , "Juin", 45
        .Add , , "Juil", 45
        .Add , , "Août", 45
        .Add , , "Sept", 45
        .Add , , "Oct", 45
        .Add , , "Nov", 45
        .Add , , "Déc", 45
    End With
 
    'Remplissage de la 1ere colonne (création de 5 lignes)
    With .ListItems
        .Add , , "TDB"
        .Add , , "ENRICH_TDB"
        .Add , , "PDA"
        .Add , , "ENRICH_PDA"
        .Add , , "RPP"
    End With
 
.ListItems(1).ListSubItems.Add , , "Résultat"
.ListItems(1).ListSubItems(Me.ListView1.ListItems(1).ListSubItems.Count).Tag = "C1L1"
 
.ListItems(1).ListSubItems.Add , , 1
.ListItems(1).ListSubItems.Add , , 2
.ListItems(1).ListSubItems.Add , , 3
.ListItems(1).ListSubItems.Add , , 4
.ListItems(1).ListSubItems.Add , , 5
.ListItems(1).ListSubItems.Add , , 6
.ListItems(1).ListSubItems.Add , , 7
.ListItems(1).ListSubItems.Add , , 8
.ListItems(1).ListSubItems.Add , , 9
.ListItems(1).ListSubItems.Add , , 10
 
.ListItems(2).ListSubItems.Add , , "Numérateur"
 
.ListItems(2).ListSubItems.Add , , 10
.ListItems(2).ListSubItems.Add , , 9
.ListItems(2).ListSubItems.Add , , 8
.ListItems(2).ListSubItems.Add , , 7
.ListItems(2).ListSubItems.Add , , 6
.ListItems(2).ListSubItems.Add , , 5
.ListItems(2).ListSubItems.Add , , 4
.ListItems(2).ListSubItems.Add , , 3
.ListItems(2).ListSubItems.Add , , 2
.ListItems(2).ListSubItems.Add , , 1
 
.ListItems(3).ListSubItems.Add , , "Dénominateur"
.ListItems(4).ListSubItems.Add , , "Classement national"
.ListItems(5).ListSubItems.Add , , "Classement sur 25 CPAM (cat2)"
 
End With
 
'-----------------------------------------------------------------
'Mémorisation des ColumnHeaders de la listview dans l'optique d'une comparaison avec les coordonnées x, y de l'èvenement MouseDown
'-----------------------------------------------------------------
 
Temp = "Valeurs 'Right' (Left+Width) de chaque colonne du listview :"
 
For a = 1 To Me.ListView1.ColumnHeaders.Count - 1
    TabPositionLeftColonneListView(a - 1, 0) = a - 1
    ValeurLeft = Me.ListView1.ColumnHeaders(a).Left
    ValeurWidth = Me.ListView1.ColumnHeaders(a).Width
    ValeurRight = ValeurLeft + ValeurWidth
    TabPositionLeftColonneListView(a - 1, 1) = ValeurRight
    Temp = Temp & vbLf & "Colonne " & TabPositionLeftColonneListView(a - 1, 0) & " - Left + Width = " & TabPositionLeftColonneListView(a - 1, 1)
Next a
 
Me.TextBox1 = Temp
 
 
'Spécifie l'affichage en mode "Détails"
ListView1.View = lvwReport
ListView1.LabelEdit = 1
ListView1.FullRowSelect = True
'ListView1.Gridlines = True
 
'-------------------------------------------------------------------------
'Création d'une barre de menu contextuel pour le listview
 
'Dim CBar As CommandBar, CBut As CommandBarButton
'Dim CTxt As CommandBarComboBox, CPop1 As CommandBarPopup, CPop2 As CommandBarPopup
 
'Set CBar = CommandBars.Add("MenuListView", msoBarPopup, False, True)
 
'Set CPop1 = CBar.Controls.Add(msoControlPopup)
'With CPop1
    '.Caption = "Actualiser les données"
'End With
 
End Sub

Après de multiples recherches, je sais qu'il y a peut être une histoire de Pixels et de Twips
Je vous liste ci-dessous les liens les plus pertinents que j'ai glané mais sans parvenir à les exploiter

https://markdagosta.com/2010/08/08/listview-hittest-right-click/
https://www.developpez.net/forums/d1...ent-d-colonne/
https://www.developpez.net/forums/d9...rvolee-souris/
https://www.experts-exchange.com/que...-subitems.html

Bonjour,

Je n'ai plus accès aux Listviews parce qu'on m'a migré en 64 bits...
Par contre, j'avais déjà utilisé ceci. À toi d'adapter...
Je pense que le nécessaire est là (?)

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
Option Explicit
 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal lMsg As Long, ByVal wParam As Long, _
    lParam As Any) As Long
 
Private Const LVM_FIRST = &H1000&
Private Const LVM_SUBITEMHITTEST = (LVM_FIRST + 57)
 
Private Const LVHT_NOWHERE = &H1
Private Const LVHT_ONITEMICON = &H2
Private Const LVHT_ONITEMLABEL = &H4
Private Const LVHT_ONITEMSTATEICON = &H8
Private Const LVHT_ONITEM = (LVHT_ONITEMICON Or LVHT_ONITEMLABEL Or _
    LVHT_ONITEMSTATEICON)
 
Private Type POINTAPI
    x           As Long
    y           As Long
End Type
 
Private Type LVHITTESTINFO
    pt          As POINTAPI
    lFlags      As Long
    lItem       As Long
    lSubItem    As Long
End Type
 
Private Sub LView_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
    Dim tHitTest        As LVHITTESTINFO
    Dim sLocation       As String
 
    HitTestEx x, y, tHitTest, LView
 
    sLocation = "Item " & tHitTest.lItem + 1 & _
         ", SubItem " & tHitTest.lSubItem
 
    Select Case tHitTest.lFlags
         Case LVHT_NOWHERE
             sLocation = "Nowhere"
         Case LVHT_ONITEMICON
             sLocation = sLocation & ", on Icon"
         Case LVHT_ONITEMLABEL
             sLocation = sLocation & ", on Label"
         Case LVHT_ONITEMSTATEICON
             sLocation = sLocation & ", on State Icon"
    End Select
 
    Colonne = tHitTest.lSubItem + 1
    Ligne = tHitTest.lItem + 1
    If Colonne >= 2 And Ligne > 0 And Ligne <= LView.ListItems.Count Then
        Set LV = LView
        frmUpdateLView.Show
        Set LV = Nothing
    End If
 
End Sub
 
Private Sub HitTestEx(ByVal x As Single, ByVal y As Single, tHitTest As LVHITTESTINFO, LV As ListView)
 
    Dim lResult         As Long
 
    With tHitTest
         .lFlags = 0
         .lItem = 0
         .lSubItem = 0
         .pt.x = x
         .pt.y = y
    End With
 
    lResult = SendMessage(LV.hwnd, LVM_SUBITEMHITTEST, 0, tHitTest)
 
 End Sub

15/06/2017, 16h53
Daranc

Bonjour
Tu ne confonds pas position du curseur et tailles de colonnes?
Tu ajoutes des largeurs, mais ton listview ne part pas de zéro , il faut peut être ajouter la position de départ de ton listview, voir à convertir également en coordonnées les largeurs,
si tu relèves les positions de tes pointages, au milieu de chaque colonne tu ne pourrais pas t'en servir pour "recadrer ton étalonnage"

Citation:

Envoyé par parmi

Bonjour,

Je n'ai plus accès aux Listviews parce qu'on m'a migré en 64 bits...
Par contre, j'avais déjà utilisé ceci. À toi d'adapter...
Je pense que le nécessaire est là (?)

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
Option Explicit
 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal lMsg As Long, ByVal wParam As Long, _
    lParam As Any) As Long
 
Private Const LVM_FIRST = &H1000&
Private Const LVM_SUBITEMHITTEST = (LVM_FIRST + 57)
 
Private Const LVHT_NOWHERE = &H1
Private Const LVHT_ONITEMICON = &H2
Private Const LVHT_ONITEMLABEL = &H4
Private Const LVHT_ONITEMSTATEICON = &H8
Private Const LVHT_ONITEM = (LVHT_ONITEMICON Or LVHT_ONITEMLABEL Or _
    LVHT_ONITEMSTATEICON)
 
Private Type POINTAPI
    x           As Long
    y           As Long
End Type
 
Private Type LVHITTESTINFO
    pt          As POINTAPI
    lFlags      As Long
    lItem       As Long
    lSubItem    As Long
End Type
 
Private Sub LView_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
    Dim tHitTest        As LVHITTESTINFO
    Dim sLocation       As String
 
    HitTestEx x, y, tHitTest, LView
 
    sLocation = "Item " & tHitTest.lItem + 1 & _
         ", SubItem " & tHitTest.lSubItem
 
    Select Case tHitTest.lFlags
         Case LVHT_NOWHERE
             sLocation = "Nowhere"
         Case LVHT_ONITEMICON
             sLocation = sLocation & ", on Icon"
         Case LVHT_ONITEMLABEL
             sLocation = sLocation & ", on Label"
         Case LVHT_ONITEMSTATEICON
             sLocation = sLocation & ", on State Icon"
    End Select
 
    Colonne = tHitTest.lSubItem + 1
    Ligne = tHitTest.lItem + 1
    If Colonne >= 2 And Ligne > 0 And Ligne <= LView.ListItems.Count Then
        Set LV = LView
        frmUpdateLView.Show
        Set LV = Nothing
    End If
 
End Sub
 
Private Sub HitTestEx(ByVal x As Single, ByVal y As Single, tHitTest As LVHITTESTINFO, LV As ListView)
 
    Dim lResult         As Long
 
    With tHitTest
         .lFlags = 0
         .lItem = 0
         .lSubItem = 0
         .pt.x = x
         .pt.y = y
    End With
 
    lResult = SendMessage(LV.hwnd, LVM_SUBITEMHITTEST, 0, tHitTest)
 
 End Sub

Effectivement, tout le nécessaire est présent dans ce bout de code.
J'ai toutefois une erreur sur

Code:

frmUpdateLView.Show

Il serait vraiment utile que cette fonctionnalité vienne enrichir la FAQ sur la listview ;)