Posez votre question Signaler

Info Bulle paramétrée sur Graphique Nuage de points [Résolu]

Messages postés
5
Date d'inscription
jeudi 21 août 2014
Statut
Membre
Dernière intervention
22 août 2014
 - - Dernière réponse : cs_MPi
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
 - 22 août 2014 à 11:46
VBA Office (Excel, Word ...) Posez votre question Signaler
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 ...
Afficher la suite 

7 réponses

Signaler Commenter la réponse de Gillou_46
Messages postés
5
Date d'inscription
jeudi 21 août 2014
Statut
Membre
Dernière intervention
22 août 2014
0
Merci
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
Commenter la réponse de Gillou_46
Signaler Commenter la réponse de Gillou_46
Messages postés
5
Date d'inscription
jeudi 21 août 2014
Statut
Membre
Dernière intervention
22 août 2014
0
Merci
http://cjoint.com/?0HvlRwCPfOF
Commenter la réponse de Gillou_46
Signaler Commenter la réponse de cs_MPi
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
 15
0
Merci
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 ClasseChart

Private 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 = False

End 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 If
End 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 = True
End Sub
Commenter la réponse de cs_MPi
Signaler Commenter la réponse de Gillou_46
Messages postés
5
Date d'inscription
jeudi 21 août 2014
Statut
Membre
Dernière intervention
22 août 2014
0
Merci
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
Commenter la réponse de Gillou_46
Signaler Commenter la réponse de cs_MPi
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
 15
0
Merci
Je n'avais pas remarqué, mais je ne trouve pas pourquoi...
Commenter la réponse de cs_MPi
Signaler Commenter la réponse de Gillou_46
Messages postés
5
Date d'inscription
jeudi 21 août 2014
Statut
Membre
Dernière intervention
22 août 2014
0
Merci
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
Commenter la réponse de Gillou_46
Signaler Commenter la réponse de cs_MPi
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
 15
0
Merci
Excellent !
Commenter la réponse de cs_MPi
Répondre Posez votre question