excel - 希望在 VBA 中向 xlStockOHLC 烛台图表添加高点和低点工具提示

Question

在 Windows 上运行。
我看到很多关于 SO 的例子，但它们都在 JS 中。
我正在使用 VBA 并使用以下内容创建我的烛台图表:

    OHLCChartObject.name = OHLCChartName
        With OHLCChartObject.Chart
        .SetSourceData Source:=getOHLCChartSource
        .ChartType = xlStockOHLC
        .Axes(xlCategory).CategoryType = xlCategoryScale
        .HasTitle = True
        .ChartTitle.Text = ""
        .HasLegend = False
        With .ChartGroups(1)
            .UpBars.Interior.ColorIndex = 10
            .DownBars.Interior.ColorIndex = 3
        End With
    End With
End Sub

有没有办法添加工具提示来显示实际的打开/高/低/关闭值？

Answer 1

可以尝试一些解决方法。



代替更改工具提示，在测试中它用于显示嵌入图表本身的形状“矩形 2”中的值。但是可以轻松修改它以显示结果以及标题或Datalabel。鼠标移动的点。

创建一个名为 XChart 的类模块带有图表事件

类模块代码

已编辑:添加了修改数据标签的附加功能。

Option Explicit
Public WithEvents Ohlc As Chart
Public Arr1 As Variant, Arr2 As Variant, Arr3 As Variant, Arr4 As Variant
Private Sub Ohlc_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
Dim IDNum As Long, a As Long, b As Long
Dim i As Long, txt As String, ht As Long, txt2 As String
Ohlc.GetChartElement x, y, IDNum, a, b

If IDNum <> xlSeries Then
'Finding XlSeries in OHLC chart is little difficult
'So try all Y values correspoding to X in the chart to find XlSeries
'However this compromise performace
ht = Ohlc.Parent.Height
    For y = 1 To ht
    Ohlc.GetChartElement x, y, IDNum, a, b   'c, d
    If IDNum = xlSeries Then Exit For
    Next
End If

If IDNum = xlSeries Then
' For Test purpose, May delete next 5 lines
ActiveSheet.Range("L1").Value = x
ActiveSheet.Range("L2").Value = y
ActiveSheet.Range("L3").Value = IDNum
ActiveSheet.Range("L4").Value = a
ActiveSheet.Range("L5").Value = b
    If b > 0 Then
    ActiveSheet.Range("M1").Value = Arr1(b)  ' For Test purpose, may delete
    txt = "Open: " & Arr1(b) & " High: " & Arr2(b) & vbCrLf & _
            "Low: " & Arr3(b) & " Close: " & Arr4(b)
    txt2 = "O: " & Arr1(b) & " H: " & Arr2(b) & _
            " L: " & Arr3(b) & " C: " & Arr4(b)
    Ohlc.Shapes("Rectangle 2").TextEffect.Text = txt

       For i = 1 To Ohlc.SeriesCollection(1).Points.Count
       With Ohlc.SeriesCollection(1).Points(i)
            If i = b Then
            .HasDataLabel = True
            .DataLabel.Text = txt2
            Else
            .HasDataLabel = False
            End If
       End With
       Next
    End If
End If
End Sub
Public Sub Storevalues()
Arr1 = Ohlc.SeriesCollection(1).Values
Arr2 = Ohlc.SeriesCollection(2).Values
Arr3 = Ohlc.SeriesCollection(3).Values
Arr4 = Ohlc.SeriesCollection(4).Values
End Sub

接下来在创建图表的标准模块中的 VBA 代码中或在其他一些事件/过程中，将图表设置为新 XChart .为了测试，使用了已经存在的图表。它也可以在工作簿打开事件中使用。

Public XOhlc As New XChart
Sub initChart()
Dim Ch As Chart
'Modify the line to your requirement
Set Ch = ThisWorkbook.Worksheets("Sheet1").ChartObjects("Chart 3").Chart
Set XOhlc.Ohlc = Ch
XOhlc.Storevalues
End Sub

所有工作表、图表、形状等名称都可以根据需要进行修改。