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

Question

Sujet Précédent Sujet Suivant

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

Signaler

Gillou_46

Messages postés: 5
Date d'inscription: jeudi 21 août 2014
Statut: Membre
Dernière intervention: 22 août 2014

- 21 août 2014 à 10:36
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

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 ...

A voir également:

Vba info
Vba infobulle - Meilleures réponses
Getchartelement - Meilleures réponses
EXCEL VBA - Info bulle lors d'un passage du curseur sur textbox, label ou combob - Forum - Visual Basic
Visual Basic / VB.NET : Info Bulle sur un objet VBA dans une feuille Excel - CodeS SourceS - Guide
VBA Excel - optimiser code recherche info sur internet ✓ - Forum - VBA Office (Excel, Word ...)
[Déplacé VB6 --> VBA] mise en forme excel + récup info ✓ - Forum - Visual Basic 6
Débutant VBA - Pb urgent - transfert d'info d'un onglet à un autre ✓ - Forum - Visual Basic 6

7 réponses

Répondre Posez votre question

Gillou_46 · Answer 1 · 2014-08-21T11:31:17+0200

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 2 · 2014-08-21T11:44:44+0200

Réponse 2 / 7

Gillou_46

Messages postés: 5
Date d'inscription: jeudi 21 août 2014
Statut: Membre
Dernière intervention: 22 août 2014

21 août 2014 à 11:44

http://cjoint.com/?0HvlRwCPfOF

cs_MPi · Answer 3 · 2014-08-21T16:14:29+0200

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

Gillou_46 · Answer 4 · 2014-08-21T17:17:16+0200

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 5 · 2014-08-21T20:50:56+0200

Réponse 5 / 7

cs_MPi

Messages postés: 3877
Date d'inscription: mardi 19 mars 2002
Statut: Membre
Dernière intervention: 23 août 2018

18
21 août 2014 à 20:50

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

Gillou_46 · Answer 6 · 2014-08-22T11:41:26+0200

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 7 · 2014-08-22T11:46:59+0200

Réponse 7 / 7

cs_MPi

Messages postés: 3877
Date d'inscription: mardi 19 mars 2002
Statut: Membre
Dernière intervention: 23 août 2018

18
22 août 2014 à 11:46

Excellent !

Votre réponse