★☆★☆★☆★☆★☆★☆★获取Excel鼠标动作的COM加载项

zanjero · 发表于 2009-9-12 11:18

源码下载：

Excel Events.rar (10.73 KB, 下载次数: 177)

标准模块代码：

Option Explicit
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'寻找窗口列表中第一个符合指定条件的顶级窗口（在vb里使用：FindWindow最常见的一个用途是获得ThunderRTMain类的隐藏窗口的句柄；
'该类是所有运行中vb执行程序的一部分。获得句柄后，可用api函数GetWindowText取得这个窗口的名称；该名也是应用程序的标题）
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
'在窗口列表中寻找与指定条件相符的第一个子窗口
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
'从指定窗口的结构中取得信息
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'在窗口结构中为指定的窗口设置信息
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'将消息传答窗口函数
Public hwnd5 As Long
Public preWinProc As Long
Public xlapp As Application
Public Const GWL_WNDPROC = (-4)
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_MOUSEWHEEL = &H20A
Public Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'以下会截取Mouse
Select Case Msg
Case WM_MOUSEMOVE
Debug.Print "鼠标移动"
Case WM_LBUTTONDOWN
MsgBox "你按了左键"
Case WM_RBUTTONDOWN
MsgBox "你按了右键"
Case WM_MOUSEWHEEL
'写下事件
If wParam > 0 Then '正数是上滚
MsgBox "滚轮向上↑↑↑"
Else
MsgBox "滚轮向下↓↓↓"
End If
End Select
'将之送往原来的Window Procedure
WndProc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End Function

复制代码

设计器代码：

Option Explicit
Private Sub AddinInstance_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant)
'设置应用程序变量
Set xlapp = Application
Dim hwnd1, hWndDesk
hwnd1 = FindWindow("XLMAIN", xlapp.Caption)
hWndDesk = FindWindowEx(hwnd1, 0&, "XLDESK", vbNullString)
'注释: 取得Excel编辑区
hwnd5 = FindWindowEx(hWndDesk, 0&, "EXCEL7", vbNullString) 'Excel 主窗体
'注释: 记录原本的Window Procedure的位址
preWinProc = GetWindowLong(hwnd5, GWL_WNDPROC)
'注释: 设定EditBox的window Procedure到wndproc
SetWindowLong hwnd5, GWL_WNDPROC, AddressOf WndProc
End Sub
Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
'从内存中缷载插件时处理
'取消Message的截取，而使之又只送往原来的Window Procedure
SetWindowLong hwnd5, GWL_WNDPROC, preWinProc
'释放占用的内存
Set xlapp = Nothing
End Sub

复制代码

[ 本帖最后由 zanjero 于 2009-9-12 11:34 编辑 ]

xianla · 发表于 2009-9-12 11:25

牛呀。先收藏了，现在还看不懂

amolin · 发表于 2009-9-12 11:27

不错，Very Good!

zanjero · 发表于 2009-9-12 17:41

原帖由 zyg365 于 2009-9-12 17:12 发表
重新发布的Dll文件不能正常使用，提示：“运行时错误13，类型不匹配”

我这边是好的啊

有源码，自己调试吧

zyg365 · 发表于 2009-9-12 17:12

重新发布的Dll文件不能正常使用，提示：“运行时错误13，类型不匹配”

zyg365 · 发表于 2009-9-14 08:38

你的附件中的Dll文件可以正常使用，但用你的附件中的源码重新发布为Dll文件就不能正常使用。
我的Excel为2000

zanjero · 发表于 2009-9-14 08:56

原帖由 zyg365 于 2009-9-14 08:38 发表
你的附件中的Dll文件可以正常使用，但用你的附件中的源码重新发布为Dll文件就不能正常使用。
我的Excel为2000

再发，这个应该是一样的，在我这重新发布也正常，xp+vb 6.0 sp6+office2003

Excel Events.rar (10.72 KB, 下载次数: 49)

zyg365 · 发表于 2009-9-14 14:27

在我这问题依旧？？？？？？？？？

[ 本帖最后由 zyg365 于 2009-9-14 14:30 编辑 ]

zanjero · 发表于 2009-9-14 16:49

原帖由 zyg365 于 2009-9-14 14:27 发表
在我这问题依旧？？？？？？？？？

你上传的附件是好的，问题可能出在编译或运行环境上

lipton · 发表于 2009-9-14 16:58

谢谢分享

		自动登录	找回密码
密码			免费注册

[原创] ★☆★☆★☆★☆★☆★☆★获取Excel鼠标动作的COM加载项

回复 1楼 zanjero 的帖子

回复 5楼 zanjero 的帖子

回复 7楼 zanjero 的帖子