Diagramm: bei 'mouseover' best. Zelleninfo zeigen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Chart_MouseUp(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 Dim myX As Variant, myY As Double With ActiveChart ' Pass x & y, return ElementID and Args .GetChartElement x, y, ElementID, Arg1, Arg2 ' Did we click over a point or data label? If ElementID = xlSeries Or ElementID = xlDataLabel Then If Arg2 > 0 Then ' Extract x value from array of x values myX = WorksheetFunction.Index _ (.SeriesCollection(Arg1).XValues, Arg2) ' Extract y value from array of y values myY = WorksheetFunction.Index _ (.SeriesCollection(Arg1).Values, Arg2) ' Display message box with point information MsgBox "Series " & Arg1 & vbCrLf _ & """" & .SeriesCollection(Arg1).Name & """" & vbCrLf _ & "Point " & Arg2 & vbCrLf _ _ & "X = " & myX & vbCrLf _ & "Y = " & myY End If End If End With

Hallo,
im folgenden Beispiel wird ein Shape rechts oben im Diagramm erzeugt. Beim Mousemove-Ereignis über einen Datenpunkt werden die Infos aus Tabelle1 in diesem Shape angezegt.
Aktiviert wird das ganze, wenn das Diagramm-Sheet aktiviert wird (zB beim Wechsel von einer Tabelle zu dem Diagramm). Der Code muss ins Klassenmodul von Diagramm1.
Gruß
Christian


Option Explicit
Private Const SHNAME As String = "ChartTip"
Dim shInfo As Shape
Private Sub Chart_Activate()
Dim sh As Shape
For Each sh In ActiveChart.Shapes
If sh.Name = SHNAME Then
sh.Delete
Set shInfo = Nothing
End If
Next
With ActiveChart
Set shInfo = .Shapes.AddShape(1, .ChartArea.Width - 100, .ChartArea.Top + 10, 80, 50)
shInfo.Name = SHNAME
End With
End Sub
Private Sub Chart_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y  _
_
As Long)
Dim lngElmt&, lngSer&, lngPnt&
Dim strTxt As String
Dim varX, varRow
With Sheets("Tabelle1")
ActiveChart.GetChartElement x, y, lngElmt, lngSer, lngPnt
If Not shInfo Is Nothing Then
If lngElmt  xlSeries Then shInfo.TextFrame.Characters.Text = "": Exit Sub
End If
If lngPnt > 0 Then
varX = Application.Index(ActiveChart.SeriesCollection(lngSer).XValues, lngPnt)
varRow = Application.Match(CDbl(varX), .Columns(3), 0)
strTxt = _
.Cells(varRow, 1) & vbLf & _
"ICAO: " & .Cells(varRow, 2) & vbLf & _
"N: " & .Cells(varRow, 3) & vbLf & _
"E: " & .Cells(varRow, 4)
If Not shInfo Is Nothing Then
shInfo.TextFrame.Characters.Text = strTxt
shInfo.TextFrame.Characters.Font.Size = 8
End If
End If
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Diagramm: bei 'mouseover' best. Zelleninfo zeigen

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Diagramm: bei 'mouseover' best. Zelleninfo zeigen

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread