如何使用 vba 将自定义工具提示与 excel 图表一起使用?
How can custom tooltips be used with excel charts using vba?
我希望使用 vba 在图表上创建自定义弹出显示。
Like this except instad of "Value: 6" 显示相应的评论。 "Yes"
Here 是一篇带有示例工作簿的文章,当鼠标悬停在图表上的某个点上时会显示一个文本框。网站上的解释不够详细,我无法理解发生了什么。当我尝试修改示例工作簿时,它停止运行。
有没有一种方法可以跟踪 excel vba 代码以发现它在做什么?或者,是否有更好的简单方法来使用 excel 图表创建自定义工具提示?
谢谢。
创建图表(作为新的 sheet,而不是嵌入式图表)并将 sheet 的 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" 的元素上时创建一个文本框。
我希望使用 vba 在图表上创建自定义弹出显示。
Like this except instad of "Value: 6" 显示相应的评论。 "Yes"
Here 是一篇带有示例工作簿的文章,当鼠标悬停在图表上的某个点上时会显示一个文本框。网站上的解释不够详细,我无法理解发生了什么。当我尝试修改示例工作簿时,它停止运行。
有没有一种方法可以跟踪 excel vba 代码以发现它在做什么?或者,是否有更好的简单方法来使用 excel 图表创建自定义工具提示?
谢谢。
创建图表(作为新的 sheet,而不是嵌入式图表)并将 sheet 的 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" 的元素上时创建一个文本框。