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