Info Bulle paramétrée sur Graphique Nuage de pointsRésolu

Question

Mesdames, Messieurs Bonjour !

Je viens vers vous aujourd'hui car j'ai trouvé (sur ce site et d'autres) des morceaux de codes qui ressemble à ce que je veux réaliser mais que je n'arrive pas à adapter à ce que je veux faire.


- Le besoin:

J'ai une macro VBA qui à partir d'un fichier texte génère un fichier Excel contenant  des graphiques ( Exemple_#1.xlsx ci-joint ).
Ce que je souhaite faire aujourd'hui c'est lorsque je balade la souris sur ce graphique je veux afficher dans un rectangle texte contenant toute une série de données (colonnes 1 à 10 de la page Données du point en question).
Ces graphiques sont dans une page et non en tant qu'objet d'une page.

Ces graphiques se composent de 3 types de données (une bleu & une rouge avec la même abscisse et ordonnée ainsi qu'une verte avec la même abscisse et une ordonnée #2). Chaque type de donnée peut être composé d'une ou plusieurs séries (une série ne pouvant pas contenir plus de 32000 valeurs, il se peut donc qu'il y en ait 2/3/4/....).


- L'exemple:

En gros ce que je souhaite faire est réalisé dans l'exemple trouvé (Recap.xls): lorsque l'on balade la souris sur une donnée du nuage, un rectangle apparait avec diverses informations.
Sauf qu'il n'y a qu'un seul graphe avec une seule série et qu'il est situé en tant qu'objet d'une page.  


J'espère avoir été clair.

Merci d'avance pour votre aide à toutes et à tous.

Dans l'attente de vos nouvelles

Gilles


PS: je suis nouveau sur ce site, je ne trouve pas pour mettre une pièce jointe ...

Gillou_46 · Answer

Voilà les extraits de codes de l'exemple trouvé Récap.xls:

Dans ThisWorbook:

Option Explicit

Dim ClTabChart As ClasseChart

Private Sub Workbook_Open()
    Dim i As Integer
    
    Set ClTabChart = New ClasseChart
    'Spécifie le 1er graphique de la Y.S Densité
    Set ClTabChart.Graph = Worksheets("Y.S Densité").ChartObjects(1).Chart

Worksheets("Y.S Densité").ChartObjects(1).Activate
    
    'désactive les intitulés et les valeurs
    Application.ShowChartTipNames = False
    Application.ShowChartTipValues = False
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    'réactive les intitulés et les valeurs
    Application.ShowChartTipNames = True
    Application.ShowChartTipValues = True
End Sub


et dans le module de classe ClasseChart :

Option Explicit

Public WithEvents Graph As Chart

'*** Utilisation des évènements *********

Private Sub Graph_MouseMove(ByVal Button As Long, ByVal Shift As Long, _
                    ByVal x As Long, ByVal y As Long)
            
    Dim ElementID As Long
    Dim Arg1 As Long, Arg2 As Long

On Error Resume Next
    ActiveChart.GetChartElement x, y, ElementID, Arg1, Arg2
            
    If Arg2 = 0 Then
        ActiveChart.Shapes("Rectangle 1").Visible = msoFalse
        Else
        
        With ActiveChart.Shapes("Rectangle 1")
            .Visible = msoTrue
            .TextFrame.Characters.Text = _
                Range("C1").Offset(Arg2, -2) & vbCrLf & _
                "Porosité" & "=" & Range("C1").Offset(Arg2, -1) & vbCrLf & _
                "YS" & "=" & Range("C1").Offset(Arg2, 0)
            .Left = 0
            .Top = 0
            .Width = "200"
            .Height = "50"
            
        End With
    End If
End Sub

Gillou_46 · Answer

http://cjoint.com/?0HvlRwCPfOF

cs_MPi · Answer

Bonjour,

Essaie ceci 
Dans chaque feuille de graphique, insère une forme Rectangle, avec fond blanc, police noire (ou autre), bordure au choix...

et mets ce code
Dim ClTabChart As ClasseChartPrivate Sub Chart_Activate()    Set ClTabChart = New ClasseChart        'Spécifie le graphique    Set ClTabChart.Graph = ActiveChart    'désactive les intitulés et les valeurs    Application.ShowChartTipNames = False    Application.ShowChartTipValues = FalseEnd Sub

Au niveau de la classe, ajuste les colonnes que tu veux voir s'afficher au besoin
Public WithEvents Graph As Chart'*** Utilisation des évènements *********Private Sub Graph_MouseMove(ByVal Button As Long, ByVal Shift As Long, _                    ByVal x As Long, ByVal y As Long)                Dim ElementID As Long    Dim Arg1 As Long, Arg2 As Long    Dim Data As Worksheet        Set Data = Sheets("Données")        On Error Resume Next    ActiveChart.GetChartElement x, y, ElementID, Arg1, Arg2                If Arg2 = 0 Then        ActiveChart.Shapes("Rectangle 1").Visible = msoFalse        Else                With ActiveChart.Shapes("Rectangle 1")            .Visible = msoTrue            .TextFrame.Characters.Text = _                Data.Range("C1").Offset(Arg2, -2) & vbCrLf & _                Data.Range("C1").Offset(Arg2, -1) & vbCrLf & _                Data.Range("C1").Offset(Arg2, 0) & vbCrLf & _                Data.Range("C1").Offset(Arg2, 1) & vbCrLf & _                Data.Range("C1").Offset(Arg2, 2) & vbCrLf & _                Data.Range("C1").Offset(Arg2, 3) & vbCrLf & _                Data.Range("C1").Offset(Arg2, 4) & vbCrLf & _                Data.Range("C1").Offset(Arg2, 5) & vbCrLf & _                Data.Range("C1").Offset(Arg2, 6)            .Left = 0            .Top = 0            .Width = "200"            .Height = "150" 'ajuster la hauteur au besoin                    End With    End IfEnd Sub

Finalement, dans ThisWorkbook, je pense que je ne mettrais que ceci
Private Sub Workbook_BeforeClose(Cancel As Boolean)    'réactive les intitulés et les valeurs    Application.ShowChartTipNames = True    Application.ShowChartTipValues = TrueEnd Sub

Gillou_46 · Answer

Alors là ..... CHAPEAU ! Merci cs_MPi

Si je comprends bien :
- x,y sont les coordonnées en pixel du point où si situe la souris
- ElementID est le type d'élément sur lequel se situe la souris ( au passage j'ai mofifié If Arg2 = 0 Then en  If ElementID <> 3 Then comme cela le rectangle ne s'affiche que si l'on est sur une série)
- Arg1 c'est le numéro de la série
- Arg2 c'est la n_ième valeur du nuage de point, il vaut 3 si on est sur le 3ième point de la série.

J'espère que jusque là j'ai bon ?!

Donc tout fonctionne très bien sur le premier graphe, je m'explique (cf image ci-dessous):

- mon premier graphe va de la ligne 2 à 478 (valeurs variables)
- mon deuxième graphe va de la ligne 479 à 800 (valeurs variables)


Donc pour le premier graphe les infos du rectangle sont bonnes mais pour le second, l'info du point 1 correspond à la ligne 2 et non à la ligne 479.

Une petite idée supplémentaire ?

Merci encore

Gilles

cs_MPi · Answer

Je n'avais pas remarqué, mais je ne trouve pas pourquoi...

Gillou_46 · Answer

Yes !!!

en fait il faut décaler de la valeur de la première ligne de la série:


Public WithEvents Graph As Chart

'*** Utilisation des évènements *********

Private Sub Graph_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, premiere_ligne_série As Long
    Dim Data As Worksheet
    Dim formule_série As String

Set Data = Sheets("Données")
    
    On Error Resume Next
     ActiveChart.GetChartElement x, y, ElementID, Arg1, Arg2
            
    If ElementID <> 3 Then
        ActiveChart.Shapes("Rectangle 1").Visible = msoFalse

Else
        
        With ActiveChart.Shapes("Rectangle 1")
           
            formule_série = ActiveChart.SeriesCollection(Val(Arg1)).Formula
            premiere_ligne_série = Val(Split(Split(formule_série, "$")(2), ":")(0))
            ligne_du_tableau = Arg2 + premiere_ligne_série - 2
            
            .Visible = msoTrue
            .TextFrame.Characters.Text = _
                "Colonne 1 : " & Data.Range("A1").Offset(ligne_du_tableau, 0) & vbCrLf & _
                "Colonne 2 : " & Data.Range("A1").Offset(ligne_du_tableau, 1) & vbCrLf & _
                "Colonne 3 : " & Data.Range("A1").Offset(ligne_du_tableau, 2) & vbCrLf & _
                "Colonne 4 : " & Data.Range("A1").Offset(ligne_du_tableau, 3) & vbCrLf & _
                "Colonne 5 : " & Data.Range("A1").Offset(ligne_du_tableau, 4) & vbCrLf & _
                "Colonne 6 : " & Data.Range("A1").Offset(ligne_du_tableau, 5) & vbCrLf & _
                "Colonne 7 : " & Data.Range("A1").Offset(ligne_du_tableau, 6) & vbCrLf & _
                "Colonne 8 : " & Data.Range("A1").Offset(ligne_du_tableau, 7) & vbCrLf & _
                "Colonne 9 : " & Data.Range("A1").Offset(ligne_du_tableau, 8) & vbCrLf & _
                "Colonne 10 : " & Data.Range("A1").Offset(ligne_du_tableau, 9) & vbCrLf
            .Left = 0
            .Top = 0
            .Width = "300"
            .Height = "200"
            
        End With
    End If
End Sub

J'ai fait ça en récupérant la formule de la série en question ... c'est peut-être pas le mieux mais ça marche !
Merci encore cs_MPi

:-)

A bientôt

Gilles

cs_MPi · Answer

Excellent !

Info Bulle paramétrée sur Graphique Nuage de points

7 réponses

Votre réponse

Discussions similaires