惯性聚合 高效追踪和阅读你感兴趣的博客、新闻、科技资讯
阅读原文 在惯性聚合中打开

推荐订阅源

N
Netflix TechBlog - Medium
大猫的无限游戏
大猫的无限游戏
B
Blog
J
Java Code Geeks
T
Tailwind CSS Blog
腾讯CDC
A
About on SuperTechFans
GbyAI
GbyAI
H
Help Net Security
IT之家
IT之家
L
LangChain Blog
Y
Y Combinator Blog
Hugging Face - Blog
Hugging Face - Blog
钛媒体:引领未来商业与生活新知
钛媒体:引领未来商业与生活新知
S
SegmentFault 最新的问题
博客园 - 叶小钗
小众软件
小众软件
I
InfoQ
爱范儿
爱范儿
有赞技术团队
有赞技术团队
博客园 - 司徒正美
博客园 - 【当耐特】
Jina AI
Jina AI
D
Docker

博客园 - ExcelFans

Office Tab 9.20 Office Tab 8.50 免费版 OfficeTab1.21中英文版 OfficeTab_v1.0多国语言版 ExcelTab3.0(支持Excel2007) ExcelTab_v2.2(Excel也玩多标签) ExcelTab(Excel工作簿多标签插件) 自定义控件==>按钮 编写过程 取消Active控件初始化提示 借助FLASH技术美化VBA操作界面 Excel多工作簿切换插件 Excel最小化到托盘区域插件 关于清空Office的剪切板 对Worksheet_SelectionChange事件写入代码后影响Excel剪切、复制粘贴的修正 VB6.0用GDI+保存图片为JPG、TIFF、PNG、GIF、BMP等格式 更改工作表的CodeName 更改Excel单元格中批注的显示位置 SendMessage函数的常用消息及其应用 取得Excel中某一模块内所有宏(过程)的名称
Hook运用之监控单元格拖放
ExcelFans · 2008-04-06 · via 博客园 - ExcelFans

   使用以下代码以后,当在工作表中进行单元格拖放操作时在VBE的立即窗口中就会显示出当前的操作状态(改一下代码就可以使拖放操作不能进行)

Private Declare Function LoadCursor _
    
Lib "user32" _
        
Alias "LoadCursorA" ( _
            
ByVal hInstance As Long, _
            
ByVal lpCursorName As Long) _
As Long
Public Declare Function SetWindowsHookEx _
    
Lib "user32" _
    
Alias "SetWindowsHookExA" ( _
        
ByVal idHook As Long, _
        
ByVal lpfn As Long, _
        
ByVal hmod As Long, _
        
ByVal dwThreadId As Long) _
As Long
Public Declare Function UnhookWindowsHookEx _
    
Lib "user32" ( _
        
ByVal hHook As Long) _
As Long
Public Declare Function CallNextHookEx _
    
Lib "user32" ( _
        
ByVal hHook As Long, _
        
ByVal nCode As Long, _
        
ByVal wParam As Long, _
        lParam 
As Any) _
As Long
Declare Function GetCursor _
    
Lib "user32" () _
As Long
Private Declare Function DestroyCursor _
    
Lib "user32" ( _
        
ByVal hCursor As Long) _
As Long
Private Type POINTAPI
    x 
As Long
    y 
As Long
End Type
Private Type MSLLHOOKSTRUCT
     pt 
As POINTAPI
     mouseData 
As Long
     Flags 
As Long
     time 
As Long
     dwExtraInfo 
As Long
End Type
Private Const IDC_ARROW = 32512&
Private Const WH_MOUSE_LL As Long = 14
Private Const WM_LBUTTONDOWN As Long = &H201
Private Const WM_LBUTTONUP As Long = &H202
Private Const WM_MOUSEMOVE As Long = &H200
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const WM_RBUTTONDOWN As Long = &H204
Private Const WM_RBUTTONUP As Long = &H205
Private Const HC_ACTION = 0
Private IHook As Long
Private hCursor As Long
Private Ican As Boolean
'-------设置钩子-----------
Public Sub EnableHook()
    
If IHook = 0 Then
        IHook 
= SetWindowsHookEx(WH_MOUSE_LL, AddressOf HookProc, Application.hInstance, 0)
    
End If
End Sub
'-------取消钩子-----------
Public Sub FreeHook()
    
If IHook <> 0 Then
        
Call UnhookWindowsHookEx(IHook)
        IHook 
= 0
    
End If
End Sub'---------回调----------------
Public Function HookProc(ByVal nCode As LongByVal wParam As LongByRef lParam As MSLLHOOKSTRUCT) As Long
    
On Error Resume Next
    
If nCode < 0 Then
        HookProc 
= CallNextHookEx(IHook, nCode, wParam, lParam)
        
Exit Function
    
End If
    hCursor 
= LoadCursor(Application.hInstance, 309&)
    
If nCode = HC_ACTION Then
        
Select Case wParam
            
Case WM_LBUTTONDOWN, WM_RBUTTONDOWN
                
If hCursor = GetCursor Then
                    Debug.Print 
"正在进行单元格拖放"
                    Ican 
= True
                
Else
                    Ican 
= False
                
End If
            
Case WM_LBUTTONUP, WM_RBUTTONUP
                
If Ican = True Then
                    Debug.Print 
"单元格拖放完成"
                    Ican 
= False
                
End If
            
Case WM_MOUSEMOVE
                
If hCursor = GetCursor Then Debug.Print "即将进行单元格拖放"
                
If LoadCursor(ByVal 0&, IDC_ARROW) = GetCursor And Ican = True Then Debug.Print "正在进行单元格拖放"
        
End Select
    
End If
    DestroyCursor hCursor
    HookProc 
= CallNextHookEx(IHook, nCode, wParam, lParam)
End Function