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

推荐订阅源

H
Help Net Security
Scott Helme
Scott Helme
爱范儿
爱范儿
WordPress大学
WordPress大学
博客园 - 三生石上(FineUI控件)
阮一峰的网络日志
阮一峰的网络日志
博客园 - Franky
V
V2EX
腾讯CDC
博客园_首页
博客园 - 司徒正美
酷 壳 – CoolShell
酷 壳 – CoolShell
T
Tailwind CSS Blog
freeCodeCamp Programming Tutorials: Python, JavaScript, Git & More
OSCHINA 社区最新新闻
OSCHINA 社区最新新闻
小众软件
小众软件
J
Java Code Geeks
大猫的无限游戏
大猫的无限游戏
月光博客
月光博客
Microsoft Azure Blog
Microsoft Azure Blog
B
Blog
雷峰网
雷峰网
Stack Overflow Blog
Stack Overflow Blog
IT之家
IT之家
罗磊的独立博客
Recorded Future
Recorded Future
博客园 - 聂微东
O
OpenAI News
S
Secure Thoughts
Hacker News: Ask HN
Hacker News: Ask HN
S
Schneier on Security
Hacker News - Newest:
Hacker News - Newest: "LLM"
Y
Y Combinator Blog
C
Cyber Attacks, Cyber Crime and Cyber Security
Project Zero
Project Zero
宝玉的分享
宝玉的分享
K
Kaspersky official blog
N
Netflix TechBlog - Medium
T
The Exploit Database - CXSecurity.com
Google Online Security Blog
Google Online Security Blog
cs.CL updates on arXiv.org
cs.CL updates on arXiv.org
cs.CV updates on arXiv.org
cs.CV updates on arXiv.org
Webroot Blog
Webroot Blog
云风的 BLOG
云风的 BLOG
Simon Willison's Weblog
Simon Willison's Weblog
C
Check Point Blog
D
Darknet – Hacking Tools, Hacker News & Cyber Security
L
LINUX DO - 热门话题
美团技术团队
L
Lohrmann on Cybersecurity

博客园 - 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