Nuage de points + infobulles

[pc75]

Bonjour,

Quelqu'un(e) saurait s'il est possible de gérer des infobulles sur les points d'un graphique en nuage, sans que ce graphique ne soit dans une feuille graphique ?

Dans l'affirmative, je veux bien de l'aide.

Merci.

[ZebreLoup]

Tu sais le faire si c'est dans une feuille graphique ?

[pc75]

Re,

Oui, en utilisant un objet shape.

[ZebreLoup]

Et le problème du passage en graphique intégré à une feuille se situe où ? Au niveau des coordonnées ?

Si c'est ça, ce n'était pas pour les mêmes objectifs, mais j'avais fait ce code pour avoir les coordonnées de la souris, il y a peut-être des trucs que tu peux récupérer ?

[pc75]

Re,

Le problème est que pour un graphique créé dans une feuille, on ne dispose pas de l'objet ActiveChart et on ne peut pas récupérer la valeur des points survolés (plutôt, je ne sais pas le faire, d'où ma question).

[ZebreLoup]

Je pense que le lien que je t'ai fourni peut pas mal t'aider alors. Je pense que si tu as déjà tout codé avec un graphique en tant que feuille, ça doit être assez facile à adapter.

[pc75]

Re,

Merci d'essayer de m'aider, mais ce que je cherche à faire me semble un peu différent.

J'ai une première feuille qui contient mes données :

Libellé long
Libellé court
Valeur x
Valeur y

Sue le graphique, j'affiche le libellé court dans les étiquettes car le libellé long est trop long et rend le graphique illisible.

Je souhaite, au survol des points, afficher le libellé long correspondant dans une info bulle.

[ZebreLoup]

Avec mon code, étant donné que tu récupères les coordonnées du point que pointes la souris sur le graphique, il suffit de chercher si on est près d'une donnée pour afficher le label long correspondant.
Maintenant, je t'accorde qu'il y a sûrement plus simple. Je n'ai pas trop le temps de regarder en détail, mais si tu me donnes le code que tu utilises si le graphique n'est pas incorporé dans une autre feuille, je pense qu'on pourra l'adapter.

[pc75]

Re,

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
 
Private Sub Chart_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
    Dim ElementID As Long, Arg1 As Long, Arg2 As Long
    Dim myX As Variant, myY As Double
 
    ActiveChart.Shapes("Rectangle 1").Visible = msoFalse
    With ActiveChart
        .GetChartElement x, y, ElementID, Arg1, Arg2
        ' Clic sur un point ou un label?
        If ElementID = xlSeries Or ElementID = xlDataLabel Then
            If Arg2 > 0 Then
                ' Extraire x
                myX = WorksheetFunction.Index _
                (.SeriesCollection(Arg1).XValues, Arg2)
                ' Extraire y
                myY = WorksheetFunction.Index _
                (.SeriesCollection(Arg1).Values, Arg2)
 
                ' Afficher le shape avec le libellé long
                ActiveChart.Shapes("Rectangle 1").Visible = msoTrue
                With ActiveChart.Shapes("Rectangle 1")
                    .TextFrame.AutoSize = True
                    .Visible = msoTrue
                    .TextFrame.Characters.Text = Sheets("Données").Range("C" & Arg2 + 1).Value
                    .Left = x - (x * 0.4)
                    .Top = y - (y * 0.4) - 50
                End With
            End If
        End If
    End With
End Sub

[ZebreLoup]

Ok alors voilà comment tu fais :
Tu crées un module de classe, qui s'appelle par exemple clsInteractiveChart, et tu y mets ceci (à adapter bien sûr en fonction de tes feuilles et des noms de tes objets) :

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
Option Explicit
 
Public WithEvents myChart As Chart
 
Private Sub myChart_MouseMove(ByVal Button As Long, ByVal Shift As Long, _
                    ByVal x As Long, ByVal y As Long)
 
    Dim ElementID As Long, Arg1 As Long, Arg2 As Long
    Dim myX As Variant, myY As Double
    Dim shp As Shape
 
    Set shp = Worksheets("Feuil1").Shapes("Rectangle 3")
 
    'shp.Visible = msoFalse
 
    myChart.GetChartElement x, y, ElementID, Arg1, Arg2
    ' Clic sur un point ou un label?
    If ElementID = xlSeries Or ElementID = xlDataLabel Then
        If Arg2 > 0 Then
            ' Extraire x
            myX = WorksheetFunction.Index _
            (myChart.SeriesCollection(Arg1).XValues, Arg2)
            ' Extraire y
            myY = WorksheetFunction.Index _
            (myChart.SeriesCollection(Arg1).Values, Arg2)
 
            ' Afficher le shape avec le libellé long
            shp.Visible = msoTrue
            shp.TextFrame.AutoSize = True
            shp.Visible = msoTrue
            shp.TextFrame.Characters.Text = Sheets("Feuil1").Range("A" & Arg1 - 1).Value
            shp.Left = Worksheets("Feuil1").Shapes("Chart 1").Left + x
            shp.Top = Worksheets("Feuil1").Shapes("Chart 1").Top + y
        End If
    End If
 
End Sub

Ensuite, tu mets ça dans le ThisWorkbook :

Code :

1
2
3
4
5
6
7
8
9
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("Feuil1").ChartObjects(1).Chart
End Sub

Toujours à adapter. J'ai toujours un petit souci pour le placement de la légende, il doit me manquer une coordonnée quelconque. Et le rectangle se place derrière le graphique. Mais je te laisse corriger ces deux points.

[pc75]

Re,

Merci beaucoup.

Ca fonctionne, mais effectivement, le placement des étiquettes n'est pas évident à gérer.

J'ai constaté que, pour la propriété top, les étiquettes s'affichent au dessus du point survolé s'il se situe dans la moitié supérieure du graphique, et au dessous du point s'il se situe dans la moitié inférieure.

Pour la propriété left, j'ai l'impression que la longueur du texte affiché dans l'étiquette a une influence puisque si je mets toujours le même texte, il n'y a pas de décalage.

[ZebreLoup]

Oui, il faut voir s'il n'y a pas un problème aussi de coordonnées en pixels ou en points. J'avais un peu galérer dans mon exemple plus haut pour trouver quelle coordonnée représentait quoi et pour faire la transformation point/pixel quand elle s'imposait mais ça marchait au final, il faut peut-être s'inspirer de ça sur ce point là aussi.

[pc75]

Re,

J'ai bricolé comme ça et le résultat est déjà mieux :

Code :

1
2
3
 
shp.Left = Worksheets("Graphique").Shapes("Graphique 1").Left + x - (x * 25 / 100)
shp.Top = Worksheets("Graphique").Shapes("Graphique 1").Top + y - (y * 30 / 100)

Lors de mes recherches sur le net, j'étais tombé sur ce site qui propose une solution qui a l'air de bien fonctionner, mais c'est au delà de mes connaissances.

http://www.clearlyandsimply.com/clea...xcel-2010.html

[pc75]

Re,

Bon, apparemment, c'est résolu. Merci Zebreloup de m'avoir mis sur la piste avec les points / pixels.

Voilà mon code modifié.

Le module de classe :

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
 
Option Explicit
 
Public WithEvents myChart As Chart
 
Private Sub myChart_MouseMove(ByVal Button As Long, ByVal Shift As Long, _
                    ByVal x As Long, ByVal y As Long)
 
    Dim ElementID As Long, Arg1 As Long, Arg2 As Long
    Dim myX As Variant, myY As Double
    Dim shp As Shape
 
    Const cnst_DistfromDataPoint = 5
 
    Dim dbl_Zoom As Double
    Dim dbl_PixelSize As Double
    Dim dbl_XVal As Double
    Dim dbl_YVal As Double
 
    dbl_Zoom = ActiveWindow.Zoom / 100
    dbl_PixelSize = PointsPerPixel
    Set shp = Worksheets("Graphique").Shapes("Rectangle 1")
    shp.Visible = msoFalse
    myChart.GetChartElement x, y, ElementID, Arg1, Arg2
    ' Clic sur un point ou un label?
    If ElementID = xlSeries Or ElementID = xlDataLabel Then
        If Arg2 > 0 Then
            dbl_XVal = x * dbl_PixelSize / dbl_Zoom + myChart.ChartArea.Left
            dbl_YVal = y * dbl_PixelSize / dbl_Zoom + myChart.ChartArea.Top
            ' Extraire x
            myX = WorksheetFunction.Index _
            (myChart.SeriesCollection(Arg1).XValues, Arg2)
            ' Extraire y
            myY = WorksheetFunction.Index _
            (myChart.SeriesCollection(Arg1).Values, Arg2)
 
            ' Afficher le shape avec le libellé long
            shp.Visible = msoTrue
            shp.TextFrame.AutoSize = True
            shp.TextFrame.Characters.Text = Sheets("Données").Range("C" & Arg2 + 1).Value
            shp.Left = dbl_XVal + cnst_DistfromDataPoint
            shp.Top = dbl_YVal + cnst_DistfromDataPoint - 30
            shp.Visible = msoTrue
        End If
    End If
End Sub

Dans un module :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
 
Private Const LOGPIXELSX = 88
Private Const POINTS_PER_INCH As Long = 72
 
Public Function PointsPerPixel() As Double
Dim hDC As Long
Dim lDotsPerInch As Long
    hDC = GetDC(0)
    lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
    PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
    ReleaseDC 0, hDC
End Function

Dans ThisWorkBook :

Code :

1
2
3
4
5
6
7
8
9
10
 
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("Graphique").ChartObjects(1).Chart
End Sub

[pc75]

Re,

Quand j'ai écris qu'apparemment, j'avais résolu mon souci, ce n'était vraiment qu'une apparence.

Je suis en 2010, et tout fonctionne correctement.

Par contre, ces graphiques sont destinés à être utilisés aussi par des versions 2002, et là, problème.

Les étiquettes ne s'affichent pas.

Quand je scroll verticalement, la variable dbl_XVal prend une valeur qui approche 4294967340 et si je scroll vers la droite, c'est la variable dbl_YVal qui prend cette valeur. Je reçois alors le message "La valeur tapée est en dehors des limites".

Enfin, autre curiosité, quand je veux quitter Excel, il me demande si je veux sauvegarder ou annuler, et là, l'étiquette est affichée.

Une idée ?

Merci.

[ZebreLoup]

Chez moi en 2003, pas de souci de ce genre. Il va falloir user du débuggeur sur la machine victime, j'en ai bien peur.

[pc75]

Re,

C'est bien en mode debug que j'ai pu récupérer la valeur de dbl_XVal et dbl_YVal.

Je ne comprends pas pourquoi quand je scroll vers le bas, dbl_XVal prend la valeur 4294967340 et dbl_YVal a une valeur correcte, et quand je scroll vers la droite, c'est l'inverse. dbl_YVal vaut 4294967340 et dbl_XVal semble correct.

Je ne sais pas par où continuer.

[ZebreLoup]

Quand je parlais de debug, je parlais bien sûr de toutes les étapes qui ont amené à ce résultat

[pc75]

Re,

J'ai essayé de mettre "en dur" les propriétés left et top et les étiquettes ne s'affichent même pas.

Code :

1
2
3
 
shp.Left = 100
shp.Top = 100