VBA如何获取图形里当前点击选中的数据点位置

chengsijing

如下图：我做成折线图，当我点击图形里数据点的时候，小心移动图形会显示当前选中的数据点是第几条。但当我有很多行数据的时候，这个不容易对准。有没有方法，例如点击图形的时候激发一个宏，把当前选中的数据点是属于哪行的保存在一个单元格中，这样好让我知道我点中的是哪行数据？！
我录制宏，发现当我点击某数据点的时候，出现如下代码：ActiveChart.FullSeriesCollection(1).Points(2939).Select。里面的这个2939就是这条线所选数据点的位置，我是想问怎么获得2939这个数？怎么写？
还有其它获得当前选中数据点的方法吗？

512008404

可以用Point.Name,得到所需要的值。

512008404

对图表的事件不熟悉，所以做了个按钮，通过单击刷新来获取值，供您参考。

493861364

512008404 发表于 2023-6-26 08:38
可以用Point.Name,得到所需要的值。

找了很久了

chengsijing

十分感谢。测试成功，虽然不能做到捕抓图形事件自动赋值，半自动的也能解决问题。

ZXB0312

找了很久了

512008404

chengsijing 发表于 2023-6-26 14:52
十分感谢。测试成功，虽然不能做到捕抓图形事件自动赋值，半自动的也能解决问题。

增加一个类模块，实现了自动刷新点座标功能。供您参考！


Public WithEvents objChart As Chart

Private Sub objChart_Select(ByVal ElementID As Long, ByVal Arg1 As Long, ByVal Arg2 As Long)
    Dim p As Point
    On Error Resume Next
    Set p = Selection
    If TypeName(p) = "Point" Then
         Sheet1.Cells(2, "E") = p.Name
         ActiveChart.SetElement (msoElementDataLabelTop)
         Sheet1.Cells(3, "E") = p.DataLabel.Text
         ActiveChart.SetElement (msoElementDataLabelNone)
         Debug.Print ElementID, Arg1, Arg2
     End If
End Sub

chengsijing

512008404 发表于 2023-7-1 08:27
增加一个类模块，实现了自动刷新点座标功能。供您参考！

谢谢，我看看

chengsijing

512008404 发表于 2023-7-1 08:27
增加一个类模块，实现了自动刷新点座标功能。供您参考！

果然自动，厉害

chengsijing

512008404 发表于 2023-7-1 08:27
增加一个类模块，实现了自动刷新点座标功能。供您参考！

最近在用VBA写程序，之前都是用MDB数据库做测试，想转到SQL数据库，发现一个问题，就是代码不变，我只是把MDB数据库的ODBC连接换成SQL，读取一次速度就慢了7秒左右（5万条记录左右，MDB方式要1.3秒左右，SQL方式要8.5秒左右）。太离谱了。请问您知道原因吗？有改进的余地吗？这种情况不应该啊，SQL数据库应该比MDB数据库更快才对。

大概代码如下：

1. Sub ceshi()
   
2. #If ProjectStatus = "DEV" Then
   
3.     Dim cn As ADODB.Connection
   
4.     Dim rs As ADODB.Recordset
   
5.     Set cn = New ADODB.Connection
   
6.     Set rs = New ADODB.Recordset
   
7. #Else
   
8.     Dim cn As Object
   
9.     Dim rs As Object
   
10.     Set cn = CreateObject("ADODB.Connection")
    
11.     Set rs = CreateObject("ADODB.Recordset")
    
12. 
    
13. #End If
    
14.    
    
15.     Dim lianjie As String, shijian As Double, dayArr() As Variant
    
16.     lianjie = .Cells(1, 1).Value  'MDB数据库和SQL数据库的选择
    
17.     shijian = Timer()
    
18.     With cn
    
19.         If lianjie = "本地" Then
    
20.             Sql = "select * from ceshi where dt<#" & Now() & "#"
    
21.             .Provider = "Microsoft.ACE.oledb.12.0"
    
22.             .ConnectionString = "data source=" & ActiveWorkbook.Path & "\test.mdb"
    
23.         Else
    
24.             Sql = "select * from ceshi where dt<'" & Now() & "'"
    
25.             
    
26.             .Provider = "sqloledb"
    
27.             .ConnectionString = "Server=.;Database=test;Uid=sa;Pwd=sa;"
    
28.         End If
    
29.         .Open
    
30.     End With
    
31.     rs.Open Sql, cn, 1, 1
    
32.     hangCount = rs.RecordCount
    
33.     If hangCount > 0 Then
    
34.         dayArr = rs.GetRows
    
35.         Debug.Print Format(Timer - shijian, "0.0")  '就载入记录集就 差了7秒左右。
    
36.         '.........
    
37.         
    
38.     End If
    
39.    
    
40.     Erase dayArr
    
41.     rs.Close
    
42.     Set rs = Nothing
    
43.     cn.Close
    
44.     Set cn = Nothing
    
45. End Sub
    

复制代码