如何使用vba将自定义工具提示与excel图表一起使用?

时间:2015-01-05 21:47:38

标签: excel vba excel-vba

我希望使用vba在图表上创建自定义弹出式显示。

Like this除了"价值:6"显示相应的评论。 "是"

Here是一篇带有示例工作簿的文章,该文章在鼠标悬停在图表上的某个点上时显示文本框。网站上的解释不够详细,我无法理解发生了什么。当我尝试修改示例工作簿时,它将停止运行。

是否有一种方法可以跟踪excel vba代码以发现它在做什么?或者,是否有一种更好的简单方法可以使用Excel图表创建自定义工具提示?

感谢。

1 个答案:

答案 0 :(得分:0)

创建图表(作为新工作表,而不是嵌入式图表)并将工作表的VBA代码编辑为:

Private Sub Chart_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
Dim Arg2 As Long
Dim chart_data As Variant
Dim chart_label As Variant
Dim last_bar As Long
Dim chrt As Chart
Dim ser As Series

On Error Resume Next

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

Application.ScreenUpdating = False
Set chrt = ActiveChart
Set ser = ActiveChart.SeriesCollection(1)
Set ser2 = ActiveChart.SeriesCollection(2)
chart_data1 = ser.Values
chart_label1 = ser.XValues
chart_data2 = ser2.Values
chart_label2 = ser2.XValues
Set txtbox = ActiveSheet.Shapes("hover")

If ElementID = xlSeries Then
    If Err.Number Then
        Set txtbox = ActiveSheet.Shapes.AddTextbox _
                                        (msoTextOrientationHorizontal, x, y, 400, 120) 'Textbox size
        txtbox.Name = "hover"
        txtbox.Fill.Solid
        txtbox.Fill.ForeColor.SchemeColor = 9
        txtbox.Line.DashStyle = msoLineSolid
        chrt.Shapes("hover").TextFrame.Characters.Text = "Insert text wanted to display here"
        With chrt.Shapes("hover").TextFrame.Characters.Font
            .Name = "Arial"
            .Size = 14
            .ColorIndex = 16
        End With
        last_bar = Arg2
    End If
    ser.Points(Arg2).Interior.ColorIndex = 44
    txtbox.Left = 0 'textbox location
    txtbox.Top = 0 'textbox location

Else
    txtbox.Delete
    ser.Interior.ColorIndex = 16
End If
Application.ScreenUpdating = True
End Sub

当鼠标移动位于“xlSeries”元素上时,这会创建一个文本框。