VBA Scatter Plot Hover Label

[Altzz]

Hey,

I'm just a beginner when it comes to using VBA code so I wondering if anyone could help me out

I have a Scatter graph with a lot of points on it and I want to clean it up my making the data labels only appear when they are clicked on or hovered over.

I found this after a bit of searching

Private Sub Chart_MouseDown(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 chart_data As Variant, chart_label As Variant
Dim last_bar As Long, chrt As Chart
Dim ser As Series, Txt As String


On Error Resume Next 'Sorry for this line of code, I haven't had the chance to look into why it was needed.


Me.GetChartElement x, y, ElementID, Arg1, Arg2


Set chrt = ActiveChart
Set ser = ActiveChart.SeriesCollection(1)
chart_data = ser.Values
chart_label = ser.XValues


Set txtbox = ActiveSheet.Shapes("hover") 'I suspect in the error statement is needed for this.


If ElementID = xlSeries Then


txtbox.Delete


Sheet1.Range("Ch_Series").Value = Arg1
Txt = Sheet1.Range("CH_Text").Value


Set txtbox = ActiveSheet.Shapes.AddTextbox _
(msoTextOrientationHorizontal, x - 150, y - 150, 150, 40)
txtbox.Name = "hover"
txtbox.Fill.Solid
txtbox.Fill.ForeColor.SchemeColor = 9
txtbox.Line.DashStyle = msoLineSolid
chrt.Shapes("hover").TextFrame.Characters.Text = Txt
With chrt.Shapes("hover").TextFrame.Characters.Font
.Name = "Arial"
.Size = 12
.ColorIndex = 16
End With


ser.Points(Arg2).Interior.ColorIndex = 44
txtbox.Left = x - 150
txtbox.Top = y - 150


Else
txtbox.Delete
ser.Interior.ColorIndex = 16
End If


End Sub

and it bring up a text box for each point on the graph I just don't know how to get the text in the boxes can anyone help? I guess its something to do with the named range section that I'm not doing right?

Thanks

 

[Worf]

Run the initialize events routine first:

' class module named CChartEvent
Public WithEvents EventChart As Chart
 
Private Sub eventChart_MouseDown(ByVal Button As Long, ByVal Shift&, ByVal x&, ByVal y&)
Dim ElementID&, Arg1&, Arg2 As Long, chart_data, txtbox As Shape, ser As Series, cx
On Error Resume Next
Set txtbox = EventChart.Shapes("hover")
On Error GoTo 0
If txtbox Is Nothing Then
    Set txtbox = EventChart.Shapes.AddTextbox(1, x, y, 40, 30)
    txtbox.Name = "hover"
End If
EventChart.GetChartElement x, y, ElementID, Arg1, Arg2
If ElementID = 3 Then   ' series
    Set ser = EventChart.SeriesCollection(Arg1)
    chart_data = ser.Values
    cx = ser.XValues
    txtbox.Fill.Solid
    txtbox.Fill.ForeColor.SchemeColor = 9
    txtbox.Line.DashStyle = msoLineSolid
    txtbox.TextFrame.Characters.Text = cx(Arg2) & "," & chart_data(Arg2)
    With txtbox.TextFrame.Characters.Font
        .Name = "Arial"
        .Size = 12
        .ColorIndex = 16
    End With
    ser.Points(Arg2).Interior.ColorIndex = 44
    txtbox.Left = ser.Points(Arg2).Left
    txtbox.Top = ser.Points(Arg2).Top
    txtbox.Visible = msoTrue
Else
    txtbox.Visible = msoFalse
End If
End Sub

' standard module
Dim clsAppEvent As New CAppEvent, clsChartEvent As New CChartEvent
Dim clsChartEvents() As New CChartEvent

Sub Initialize_Events()
  Set clsAppEvent.EventApp = Application
  Set_All_Charts
End Sub
 
Sub TerminateAppEvents()
  Set clsAppEvent.EventApp = Nothing
  Reset_All_Charts
End Sub

Sub Set_All_Charts()
    ' Enable events for active sheet if sheet is a chart sheet
    If TypeName(ActiveSheet) = "Chart" Then Set clsChartEvent.EventChart = ActiveSheet
    ' Enable events for all charts embedded on a sheet
    ' Works for embedded charts on a worksheet or chart sheet
    If ActiveSheet.ChartObjects.Count > 0 Then
        ReDim clsChartEvents(1 To ActiveSheet.ChartObjects.Count)
        Dim chtObj As ChartObject, chtnum%
        chtnum = 1
        For Each chtObj In ActiveSheet.ChartObjects
            Set clsChartEvents(chtnum).EventChart = chtObj.Chart
            chtnum = chtnum + 1
        Next
    End If
End Sub
 
Sub Reset_All_Charts()
    ' Disable events for all charts previously enabled together
    Dim chtnum%
    On Error Resume Next
    Set clsChartEvent.EventChart = Nothing
    For chtnum = 1 To UBound(clsChartEvents)
        Set clsChartEvents(chtnum).EventChart = Nothing
    Next ' chtnum
End Sub

 

[Roast1694]

Excuse me. I can not run your code. It is like there is not defined clsAppEvent or CAppEvent is a another class module? I hope you can reply me. Thanks!

 

[Worf]

Welcome to the Board

I will be offline for the weekend but can look into this on Monday.

 

[Roast1694]

Issue solved. Thanks!

 

[JSantos72]

Hi to all

I've just tried the code following the instructions (Excel 365) and i cant get it to work
error when initialize_events (Dim clsChartEvents() As New CChartEvent) uswer defined type not defined.

Can somenone give me a hand?

Thanks a Lot
J