钩子版动态图表-（）

minjiwei

读到ExcelPro图表博客的文章《基于地图选择的动态图表》，大受启发。博主在Chart中使用了mousemove事件，当鼠标移动到某个省份，则改变这个省份的底色，并且数据图表做相应的变化。
    如果能直接在工作表中进行基于地图的选择，相信会更实用。
    我想到前一段时间看到了论坛中Jack.zhou大师的帖子，使用钩子制作worksheet的mousemove事件。如果能把mousemove事件获得的鼠标坐标，使用rangefrompoint返回相应的对象，不就可以操作shape对象了吗？于是就对那位大师的帖子中用到的代码作了一些修改，最后也竟然达到了自己的目的。发上来和大家分享一下，如有任何建议，请不吝赐教。
    最后，向ExcelPro 的博主（ ExcelPro的图表博客http://excelpro.blog.sohu.com/）和篇中提到的大师Jack.zhou (http://club.excelhome.net/viewthread.php?tid=309543&highlight=%B9%B3%D7%D3)致敬。能够站在大师的肩膀上是幸运，更是一种荣幸。

附件vba模块没有保护，欢迎一起研究、讨论、完善。

效果图如下：

[ 本帖最后由 minjiwei 于 2010-3-11 17:55 编辑 ]

Eric_Cheung

好東西怎麼沒人頂 ...- -

lipton

下载学习，谢谢分享。

lb_bn

老师辛苦了，谢谢分享。学习。

thankgiver

一直想找些可以简单用的数据地图

飞云楼主

谢谢分享。学习。

thtfzhaobo

谢谢分享，学习

chrisfang

不需要这么复杂吧，根本不需要用Hook，用RangeFromPoint、GetCursorPos和循环就OK啦。
地图_China(chrisfang).rar (27.24 KB, 下载次数: 314)

2010-3-12 08:53 上传

点击文件名下载附件

短短几句代码

1. 
   
2. Private Declare Function GetCursorPos Lib "user32" _
   
3.         (lpPoint As MyPoint) As Long
   
4. Private Type MyPoint: X As Long: Y As Long: End Type
   
5. Public flag
   
6. Sub getshape()
   
7.     Dim CurPos As MyPoint
   
8.     Do While flag = True
   
9.     GetCursorPos CurPos
   
10.     x1 = CurPos.X: y1 = CurPos.Y
    
11.     Set CurRng = ActiveWindow.RangeFromPoint(x1, y1)
    
12.     If CurRng Is Nothing Then Exit Sub
    
13.     On Error Resume Next
    
14.    
    
15.     If CurRng.ShapeRange.AutoShapeType = 138 Then
    
16.         Range("A1") = CurRng.Name
    
17.         For Each i In ActiveSheet.Shapes
    
18.             If i.Fill.ForeColor.SchemeColor = 52 And i.Name <> CurRng.Name Then
    
19.                 i.Fill.ForeColor.SchemeColor = 65
    
20.             End If
    
21.         Next
    
22.         CurRng.ShapeRange.Fill.ForeColor.SchemeColor = 52
    
23.     End If
    
24.     DoEvents
    
25.     Loop
    
26. End Sub
    
27. 
    
28. Sub demo()
    
29.     MsgBox "开始"
    
30.     flag = True
    
31.     getshape
    
32. End Sub
    
33. Sub enddemo()
    
34.     MsgBox "结束"
    
35.     flag = False
    
36. End Sub
    

复制代码

[ 本帖最后由 chrisfang 于 2010-3-12 08:53 编辑 ]

lb_bn

谢谢版主，学习。。

minjiwei

谢谢斑竹指点。这个方法简单，实用。并且运行还挺快的。

原帖由 chrisfang 于 2010-3-11 16:43 发表
不需要这么复杂吧，根本不需要用Hook，用RangeFromPoint和Timer的循环就OK啦。
679034
短短几句代码

Private Declare Function GetCursorPos Lib "user32" _
        (lpPoint As MyPoint) As Long
Private T ...