[XL-2003] Coordonnées de la souris sur un graphique

[ZebreLoup]

Voici un petit exemple d'affichage des coordonnées correspondant à l'emplacement de la souris sur un graph.

La plupart des choses que j'utilise ont été trouvées ça et là sur le net mais je n'avais pas trouvé de tuto complet et souvent il manquait une brique.

Tout est dans le fichier joint.

- Récupération des évènements d'un graphique incorporé dans une feuille de calcul
- Récupération des coordonnées de la souris
- Transformation des pixels en point en fonction de l'écran
- Calcul des valeurs correspondantes (ne pas se perdre dans les différents Top/Left de tous les éléments du graphique)
- Mise à jour des paramètres lors d'un redimensionnement de n'importe quel élément du graphique

En espérant que ça puisse en aider certains

[Philippe JOCHMANS]

Bonjour

Merci de cette contribution, mais il est serait bon de donner plus de détails sur le code, entre autre en le mettant sur le forum car :

Tout le monde ne peut ou ne veut pas ouvrir des pièces jointes.
Lorsque ton quota de pièces jointes sera atteint (à moins d'avoir un hébergement), tu risques de supprimer le classeur, et donc cette discussion sera perdue.

Et si tu te sens une âme pour rédiger, tu peux contacter le responsable Excel pour voir si tu peux écrire quelque chose sur le sujet.

Philippe

[ZebreLoup]

Oui, tu as raison. Je me demandais avant de me lancer dans de la rédaction plus complète si ça pouvait intéresser quelqu'un.

Voici donc plus de détails :

Tout d'abord pour pouvoir accéder aux évènements d'un graphique incorporé à une feuille excel, nous allons procéder comme suit :

On crée un module de classe que j'ai appelé clsInteractiveChart
Et on y ajoute l'objet graphique

Code :

1
2
Option Explicit
Public WithEvents myChart As Chart

Pour éviter que tous les calculs soient effectués à chaque fois, on va également figer les constantes qui donneront la valeurs des ordonnées et des abscisses en fonction de la position en pixel renvoyée par les évènements

Code :

1
2
3
4
5
'Values will be given by a formula Xvalue = A * Xpixel + B
Public Ax As Single
Public Ay As Single
Public Bx As Single
Public By As Single

On va ensuite créer la méthode d'initialisation de ces variables. Elle appelle les fonctions GetPixelsToPointsRatioX et GetPixelsToPointsRatioY qui seront explicitées plus tard.
On ajoute également la fonction qui renvoie les coordonnées en fonction de la position, le type utilisateur Coords sera explicité ultérieurement.

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
Public Sub InitConversionFactors()
    Dim tmpRatio As Single
    Dim minScale As Single
    Dim maxScale As Single
    Dim graphAreaSize As Single
    Dim originPos As Single
    Dim pixelToPointsRatio As Single
 
    'X constants
    minScale = myChart.Axes(1).MinimumScale
    maxScale = myChart.Axes(1).MaximumScale
    graphAreaSize = myChart.PlotArea.insideWidth
    originPos = myChart.PlotArea.InsideLeft + myChart.ChartArea.Left
    pixelToPointsRatio = GetPixelsToPointsRatioX()
 
    tmpRatio = (maxScale - minScale) / graphAreaSize
 
    Ax = tmpRatio * pixelToPointsRatio
    Bx = minScale - originPos * tmpRatio
 
    'Y constants
    minScale = myChart.Axes(2).MinimumScale
    maxScale = myChart.Axes(2).MaximumScale
    graphAreaSize = myChart.PlotArea.InsideHeight
    originPos = myChart.PlotArea.InsideTop + myChart.ChartArea.Top + myChart.PlotArea.InsideHeight
    pixelToPointsRatio = GetPixelsToPointsRatioY()
 
    tmpRatio = (maxScale - minScale) / graphAreaSize
 
    Ay = -tmpRatio * pixelToPointsRatio 'Negative factor because coords are from the top
    By = minScale + originPos * tmpRatio
End Sub
 
Private Function getCoordsFromPixels(ByVal x As Long, ByRef y As Long) As Coords
    Dim c As Coords
    c.x = Ax * x + Bx
    c.y = Ay * y + By
    getCoordsFromPixels = c
End Function

Et pour finir on ajoute le code des évènements. MouseDown correspond au click et MouseMove au déplacements de la souris sur le graphique une fois celui-ci selectionné. On ajoute également une rédéfinition des constantes à chaque MouseUp, c'est le seul évènement que j'ai trouvé qui se déclenche quand on redimensionne une partie du graphique.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub myChart_MouseDown(ByVal Button As Long, ByVal Shift As Long, _
                    ByVal x As Long, ByVal y As Long)
    Dim c As Coords
    c = getCoordsFromPixels(x, y)
    AddNewCoords c
End Sub
 
Private Sub myChart_MouseMove(ByVal Button As Long, ByVal Shift As Long, _
                    ByVal x As Long, ByVal y As Long)
    Dim c As Coords
    c = getCoordsFromPixels(x, y)
    SetActualCoords c
End Sub
 
Private Sub myChart_Resize()
    InitConversionFactors
End Sub
 
'Each time a part of the graph is resized, we have to reset factor A and B
Private Sub myChart_MouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
    InitConversionFactors
End Sub

Ensuite il faut initialiser cette classe à l'ouverture du classeur, on ajoute donc dans ThisWorkbook le code suivant :

Code :

1
2
3
4
5
6
7
8
9
10
11
Option Explicit
 
Dim iChart As clsInteractiveChart
 
Private Sub Workbook_Open()
    'To be able to catch the chart events
    Set iChart = New clsInteractiveChart
    Set iChart.myChart = Worksheets("GraphSheet").ChartObjects(1).Chart
 
    iChart.InitConversionFactors
End Sub

Reste à rajouter dans un ou plusieurs modules le reste du code. Pour ma part, j'ai créé un module mdProgramme qui contient le type Coords (une coordonnée x, y) et les actions sur la feuille (ajouter une ligne pour chaque coordonnée cliquée et afficher les coordonnées actuelles).

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
Option Explicit
 
Public Type Coords
    x As Single
    y As Single
End Type
 
Public Sub SetActualCoords(ByRef c As Coords)
    Dim ws As Worksheet
    Set ws = Worksheets("GraphSheet")
 
    ws.Range("A6").Value = c.x
    ws.Range("B6").Value = c.y
End Sub
 
Public Sub AddNewCoords(ByRef c As Coords)
    Dim ws As Worksheet
    Set ws = Worksheets("GraphSheet")
 
    Dim i As Integer
    i = 9
 
    While ws.Cells(i, 1).Value <> ""
        i = i + 1
    Wend
 
    ws.Cells(i, 1).Value = c.x
    ws.Cells(i, 2).Value = c.y
End Sub

Et dans un module appelé mdPixelPoints tout ce qui concerne la conversion des coordonnées renvoyées par les évènements qui sont données en pixel, en points qui est l'unité utilisée par le graphique. On utilise ici les API windows afin que cela marche quels que soient l'écran et sa résolution.
(La procédure ConvertPixelsToPoints n'est pas utilisée ici mais peut servir pour d'autres applications. Tout ce code étant la simplification d'un petit programme plus complet)

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
Option Explicit
 
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
 
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
 
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
 
 
Public Sub ConvertPixelsToPoints(ByRef x As Single, ByRef y As Single)
    Dim hDC As Long
    Dim XPixelsPerInch As Long
    Dim YPixelsPerInch As Long
 
    hDC = GetDC(0)
    XPixelsPerInch = GetDeviceCaps(hDC, 88)
    YPixelsPerInch = GetDeviceCaps(hDC, 90)
    ReleaseDC 0, hDC
 
    x = x * 72 / XPixelsPerInch
    y = y * 72 / YPixelsPerInch
End Sub
 
Public Function GetPixelsToPointsRatioX() As Single
    Dim hDC As Long
    Dim pixelsPerInch As Long
 
    hDC = GetDC(0)
    pixelsPerInch = GetDeviceCaps(hDC, 88)
    ReleaseDC 0, hDC
 
    GetPixelsToPointsRatioX = 72 / pixelsPerInch
End Function
 
Public Function GetPixelsToPointsRatioY() As Single
    Dim hDC As Long
    Dim pixelsPerInch As Long
 
    hDC = GetDC(0)
    pixelsPerInch = GetDeviceCaps(hDC, 90)
    ReleaseDC 0, hDC
 
    GetPixelsToPointsRatioY = 72 / pixelsPerInch
End Function

Voilà, j'espère que ça pourra aider certains. N'hésitez pas à me le dire si ça vous a servi ou au moins intéressé. C'est ma deuxième contribution de plus de 2 lignes et la première est semble-t-il passée aux oubliettes très rapidement (d'accord c'était beaucoup plus ciblé, la création de camembert incorporés à un PDF avec iText, mais j'étais tout fier des mon algorithme de placement de la légende et de mon utilisation des courbes de béziers ! ) alors il faut garder la motivation.

[Qwazerty]

Salut

Sympa ton code.

J'ai juste étais obligé de mettre "On error resume next" ici

Code :

1
2
3
4
5
6
7
Private Function getCoordsFromPixels(ByVal x As Long, ByRef y As Long) As Coords
    'Dim c As Coords
    On Error Resume Next
    getCoordsFromPixels.x = Ax * x + Bx
    getCoordsFromPixels.y = Ay * y + By
    'getCoordsFromPixels = c
End Function

Je ne comprend pas bien, mais j'avais une erreur de division par zéro... surement dut au méthodes de calcul interne, mais c'est une "fausse erreur" puisque le calcul s'effectue.... bref.

J'utilise Excel 2007.

Merci pour cette source.
++
Qwaz

[ZebreLoup]

Je n'ai jamais eu ce problème et effectivement, l'erreur est bizarre, ce ne sont que des multiplications et des additions. Tu as vu ce qui se passait en mode pas à pas en mettant des espions sur des bouts de formules pour voir où était la division par zéro ?