标题: [原创]自定义增加EXCEL 的一些事件的DLL. [打印本页] 作者: stanleypan 时间: 2007-4-5 03:08 标题: [原创]自定义增加EXCEL 的一些事件的DLL. 对于Private Sub Workbook_Open()等事件,其实这些事件也是代码写在:EXCEL.EXE里面.从Object Browser里面可以查到:
Library Class Member
Excel Workbook Open
在WINDOWS下事件是由消息驱动来产生的.
所以通地子类化,钩住相关消息可以自定义一件事件.
对于EXCEL中不支持MouseMove,MouseUp,WheelMoved等等事件.
特做了此DLL.
缺点是占用CPU比较多.
作者: stanleypan 时间: 2007-4-5 22:15
Option Explicit
Dim WithEvents sh As MouseHook.cSystemHook
Dim WithEvents Wb As Excel.Workbook '= Dim WithEvents Wb As Workbook
Private Sub sh_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
Application.Caption = "X:" & x & ";" & "Y:" & y & " " & ActiveWindow.RangeFromPoint(x, y).Address
ActiveWindow.RangeFromPoint(x, y).Activate
End Sub
Private Sub sh_KeyDown(KeyCode As Integer, Shift As Integer)
Debug.Print "KeyDown:" & KeyCode & "; " & Shift; ""
End Sub
Private Sub sh_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
If Button = 1 Then
Debug.Print "你按了左键"
End If
If Button = 2 Then
Debug.Print "你按了右键"
End If '
If Button = 4 Then
Debug.Print "你按了中键"
End If
End Sub
'写入Workbook事件中相当不稳定.
Sub StartHook()
Set sh = New cSystemHook
sh.SetHook
End Sub
Sub StopHook()
sh.RemoveHook
Set sh = Nothing
End Sub
Private Sub sh_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Debug.Print "Mouse Up:" & Button & "; " & Shift; ""
End Sub
Private Sub sh_WheelMoved(Button As Integer, Shift As Integer, x As Single, y As Single)
Debug.Print "WheelMoved:" & Button & "; " & Shift; ""
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
sh.RemoveHook
Set sh = Nothing
End Sub
Private Sub Workbook_Open()
Set sh = New cSystemHook
sh.SetHook
End Sub