Bonjour à Tous
Je cherche le moyen d'appeler ou d'executer le code contenu dans la feuille du graphe.
A la base je souhaite récupérer les coordonnées des points du graphe. j'ai réussi à trouver un moyen de le faire (code tout en bas)
Sauf que ce code est integer directement dans le graph.
Je souhait que pour chaque graph généré ( non incorporé), je puisse récupérer les cordonnées des points
Je ne vais pas à chaque fois insérer ces lignes de code dans les graphes
Auriez vous une idée de comment je pourrai contourner ce probleme?
Je vous remercie par avance
=
Je cherche le moyen d'appeler ou d'executer le code contenu dans la feuille du graphe.
A la base je souhaite récupérer les coordonnées des points du graphe. j'ai réussi à trouver un moyen de le faire (code tout en bas)
Sauf que ce code est integer directement dans le graph.
Je souhait que pour chaque graph généré ( non incorporé), je puisse récupérer les cordonnées des points
Je ne vais pas à chaque fois insérer ces lignes de code dans les graphes
Auriez vous une idée de comment je pourrai contourner ce probleme?
Je vous remercie par avance
Code:
Private Sub Chart_Select(ByVal ElementID As Long, ByVal Arg1 As Long, ByVal Arg2 As Long)
Dim LabelStatus, X, Y, RangeX As Range, RangeY As Range, rangeXY As Range, i&
Dim Sh As Worksheet, F As String, S As String, SF As String, SR As String
If ElementID = xlSeries Then
If Arg2 = -1 Then
'msgbox "Tous les points du graphique " & Arg1 & " ont été sélectionnés"
Else
LabelStatus = ActiveChart.SeriesCollection(Arg1).Points(Arg2).HasDataLabel
ActiveChart.SeriesCollection(Arg1).Points(Arg2).HasDataLabel = True
ActiveChart.SeriesCollection(Arg1).Points(Arg2).ApplyDataLabels ShowValue:=True
Y = ActiveChart.SeriesCollection(Arg1).Points(Arg2).DataLabel.Caption
ActiveChart.SeriesCollection(Arg1).Points(Arg2).ApplyDataLabels Type:=xlDataLabelsShowLabel
X = ActiveChart.SeriesCollection(Arg1).Points(Arg2).DataLabel.Caption
ActiveChart.SeriesCollection(Arg1).Points(Arg2).HasDataLabel = LabelStatus
If LabelStatus Then ActiveChart.SeriesCollection(Arg1).Points(Arg2).ApplyDataLabels
MsgBox "X= " & X & " , Y=" & Y
F = ActiveChart.SeriesCollection(Arg1).Formula
S = Split(F, ",")(1)
SF = Left(S, InStr(S, "!") - 1)
SF = Replace(SF, "'", "")
SR = Mid(S, InStr(S, "!") + 1)
Set Sh = Sheets(SF)
Set RangeX = Sh.Range(SR)
S = Split(F, ",")(2)
SR = Mid(S, InStr(S, "!") + 1)
Set RangeY = Sh.Range(SR)
For i = 1 To RangeY.Rows.Count
If CStr(RangeY(i, 1).Value) = Y And CStr(RangeX(i, 1).Value) = X Then
Sh.Select
Union(RangeX(i, 1), RangeY(i, 1)).Select
Exit For
End If
Next i
MsgBox "Adresse de X = " & RangeX(i, 1).Address(False, False) & vbLf & _
"Adresse de Y = " & RangeY(i, 1).Address(False, False)
End If
Else
'MsgBox "Aucun point d'aucun graphique n'a été sélectionné"
End If
End Sub
=