取得Excel中某一模块内所有宏(过程)的名称

     刚才看到 有朋友问怎样取得某一模块中所有宏的名称（见 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   String ,  Optional  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

详见附件：
点击下载

转载于:https://www.cnblogs.com/wangminbai/archive/2008/03/11/1100921.html