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

推荐订阅源

Recent Announcements
Recent Announcements
让小产品的独立变现更简单 - ezindie.com
让小产品的独立变现更简单 - ezindie.com
O
OpenAI News
D
Docker
freeCodeCamp Programming Tutorials: Python, JavaScript, Git & More
N
Netflix TechBlog - Medium
人人都是产品经理
人人都是产品经理
Y
Y Combinator Blog
M
MIT News - Artificial intelligence
奇客Solidot–传递最新科技情报
奇客Solidot–传递最新科技情报
博客园 - 司徒正美
C
CXSECURITY Database RSS Feed - CXSecurity.com
阮一峰的网络日志
阮一峰的网络日志
K
Kaspersky official blog
Security Latest
Security Latest
T
Tailwind CSS Blog
cs.AI updates on arXiv.org
cs.AI updates on arXiv.org
V
Vulnerabilities – Threatpost
W
WeLiveSecurity
N
News and Events Feed by Topic
aimingoo的专栏
aimingoo的专栏
美团技术团队
OSCHINA 社区最新新闻
OSCHINA 社区最新新闻
Google DeepMind News
Google DeepMind News
CTFtime.org: upcoming CTF events
CTFtime.org: upcoming CTF events
C
Cyber Attacks, Cyber Crime and Cyber Security
Cyber Security Advisories - MS-ISAC
Cyber Security Advisories - MS-ISAC
B
Blog
T
The Blog of Author Tim Ferriss
Google DeepMind News
Google DeepMind News
Help Net Security
Help Net Security
爱范儿
爱范儿
宝玉的分享
宝玉的分享
腾讯CDC
H
Heimdal Security Blog
Webroot Blog
Webroot Blog
AI
AI
WordPress大学
WordPress大学
Recorded Future
Recorded Future
SecWiki News
SecWiki News
cs.CV updates on arXiv.org
cs.CV updates on arXiv.org
Security Archives - TechRepublic
Security Archives - TechRepublic
Google Online Security Blog
Google Online Security Blog
C
Check Point Blog
TaoSecurity Blog
TaoSecurity Blog
Cisco Talos Blog
Cisco Talos Blog
The Cloudflare Blog
www.infosecurity-magazine.com
www.infosecurity-magazine.com
博客园 - Franky
云风的 BLOG
云风的 BLOG

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