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

推荐订阅源

Microsoft Azure Blog
Microsoft Azure Blog
Google Online Security Blog
Google Online Security Blog
D
Darknet – Hacking Tools, Hacker News & Cyber Security
Threat Intelligence Blog | Flashpoint
Threat Intelligence Blog | Flashpoint
Simon Willison's Weblog
Simon Willison's Weblog
T
Threat Research - Cisco Blogs
C
CXSECURITY Database RSS Feed - CXSecurity.com
L
Lohrmann on Cybersecurity
www.infosecurity-magazine.com
www.infosecurity-magazine.com
Forbes - Security
Forbes - Security
P
Palo Alto Networks Blog
Schneier on Security
Schneier on Security
S
Schneier on Security
T
Tor Project blog
cs.CL updates on arXiv.org
cs.CL updates on arXiv.org
WordPress大学
WordPress大学
The Hacker News
The Hacker News
Hacker News - Newest:
Hacker News - Newest: "LLM"
罗磊的独立博客
Application and Cybersecurity Blog
Application and Cybersecurity Blog
F
Fortinet All Blogs
博客园 - 三生石上(FineUI控件)
小众软件
小众软件
C
Check Point Blog
Stack Overflow Blog
Stack Overflow Blog
Blog — PlanetScale
Blog — PlanetScale
雷峰网
雷峰网
S
Security @ Cisco Blogs
PCI Perspectives
PCI Perspectives
Spread Privacy
Spread Privacy
W
WeLiveSecurity
SecWiki News
SecWiki News
A
About on SuperTechFans
H
Help Net Security
博客园 - 司徒正美
Recent Commits to openclaw:main
Recent Commits to openclaw:main
爱范儿
爱范儿
S
Securelist
M
MIT News - Artificial intelligence
云风的 BLOG
云风的 BLOG
月光博客
月光博客
Jina AI
Jina AI
博客园 - 叶小钗
Vercel News
Vercel News
阮一峰的网络日志
阮一峰的网络日志
Recent Announcements
Recent Announcements
S
Secure Thoughts
The Cloudflare Blog
美团技术团队
freeCodeCamp Programming Tutorials: Python, JavaScript, Git & More

博客园 - 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剪切、复制粘贴的修正 Hook运用之监控单元格拖放 VB6.0用GDI+保存图片为JPG、TIFF、PNG、GIF、BMP等格式 更改工作表的CodeName 更改Excel单元格中批注的显示位置 SendMessage函数的常用消息及其应用
取得Excel中某一模块内所有宏(过程)的名称
ExcelFans · 2008-03-11 · via 博客园 - ExcelFans

     刚才看到 有朋友问怎样取得某一模块中所有宏的名称(见http://www.officefans.net/cdb/viewthread.php?tid=90713&extra=page%3D1),想了想,看了帮助文件,作了一个小过程。用于取得模块中宏(过程)的名称。功能及参数的说明见代码:
(注:要使用此过程请事先点击 工具  菜单--> -->安全性,在弹出的 安全性 对话框的 可靠发行商标签 中钩选 信任对“vb项目”的访问。详见附图)
代码如下:

'//-------------------------------------------------------------------------------------------------------------------
'
//---此过程用于取得工作薄中某一模块(含工作表、窗体等)中过程的名称---Code by wangminbai----
'
//---参数解释:
'
//---Codename:指定包含要取得过程的模块名称。
'
//---prockind:可选参数。指定要定位的过程种类。Property 过程在模块中可以有多种表示,必须指定要定
'
//             位的过程种类。所有过程除了Property 过程(即 Sub 和 Function 过程)用vbext_pk_Proc。
'
//             要取得多个种类请将各个种类用"+"连接。默认为vbext_pk_Proc
'
//---getPrivate :可选参数。指定是否取得过程内的私有过程。默认为"False"(不取得)。
'
//-------------------------------------------------------------------------------------------------------------------
Sub GetProcName(Codename As StringOptional prockind As vbext_ProcKind = vbext_pk_Proc, Optional getPrivate As Boolean = False)
    
Dim NewC As New Collection
    
Dim Istr As String
    
Dim i As Long, k As Long, j As Long, l As Long
    
On Error Resume Next
    
'取得模块内代码行数
    i = ThisWorkbook.VBProject.VBComponents(Codename).CodeModule.CountOfLines
    
For k = 1 To i
        
'返回行所在的过程名
        Istr = ThisWorkbook.VBProject.VBComponents(Codename).CodeModule.ProcOfLine(k, prockind)
        
If Istr <> "" Then
            NewC.Add Istr, Istr
        
End If
    
Next
    l 
= 1
    
For k = 1 To NewC.Count
        
'判断是否取得私有过程
        If getPrivate = False Then
            
'取得过程名所在行
            j = ThisWorkbook.VBProject.VBComponents(Codename).CodeModule.ProcBodyLine(CStr(NewC.Item(k)), prockind)
            
'取得过程名所在行的代码字符串
            Istr = Trim(ThisWorkbook.VBProject.VBComponents(Codename).CodeModule.Lines(j, 1))
            
'判断是否为私有过程
            If Not (Istr Like "Private*"Then
                
'将过程名写入A列
                ActiveSheet.Range("A" & l) = NewC.Item(k)
                l 
= l + 1
            
End If
        
Else
            
'将过程名写入A列
            ActiveSheet.Range("A" & k) = NewC.Item(k)
        
End If
    
Next
    
On Error GoTo 0
End Sub

详见附件:
点击下载