[已解决]【求助】提取模块里宏的名字

xdwy81129

提取模块里宏的名字

我的excel里有5-10个模块，都是连续编号的，为模块1，2，3……，注明没有类模块

而每个模块都有很多宏在里面，宏的开头都是 Sub ??? ()

宏多了不好管理，有时候什么宏有什么宏没有自己都不知道。

所以恳请老师赐教：把模块里宏的名字都提取出来，学生好方便查阅和管理。

设想的是：
A列提取为：是第几个模块
B列提取为：A留写的第几个模块里的宏的名字。

感谢老师了，恳请老师一定赐教。

最佳答案

月排行榜 / 总排行榜

1970-1-1 08:00

跳转到最佳答案楼层

开辆小富康

在VBE界面中，楼主可以点击模块1，模块2这些名字，使之选中，然后在属性窗口中修改它的名称。

xdwy81129

不，老师误会我的意思了

我的意思是，我能快速的知道我总共有哪些名字的宏，而这些宏又放在什么模块里。这样我提取以后，打印出来了，我好在纸上标注宏是起什么作用的，以及以后要增加宏我能设计加到什么模块里等等了。

所以，是要提取宏里所有的名字的。

xdwy81129

顶下：：：：（

HYY514

'工具-宏-安全性-可靠发行商-（勾选 信任对于“Visual Basic”项目的访问）
Sub test()
Dim ovbcomp As Variant
Dim i As Integer, j As Integer
Dim sMsg  As String
Dim sTmp As String
Dim sLik(2) As String
sLik(0) = "Sub "
sLik(1) = "Public Sub "
sLik(2) = "Private Sub "
For Each ovbcomp In ThisWorkbook.VBProject.VBComponents
    For i = 1 To ovbcomp.CodeModule.CountOfLines
        sTmp = ovbcomp.CodeModule.Lines(i, 1)
        For j = 0 To 2
            If sTmp Like sLik(j) & "*" Then
                sTmp = Replace(sTmp, "()", "")
                sTmp = Replace(sTmp, sLik(j), "")
                sMsg = sMsg + sTmp + vbCrLf
            End If
        Next
    Next
Next
MsgBox sMsg
End Sub

xdwy81129

感谢感谢版主了，

可MsgBox太长了，下面的我还没有方法看见，所以请老师让变量sMsg每一行放在一单元格，请老师再赐教。我只能放到一个单元格里，但浏览很有问题，所以请老师一定再帮助赐教下

开辆小富康

版主太牛了。学习

xdwy81129

顶下，希望知道怎么做的老师赐教下

xdwy81129

QUOTE:

以下是引用xdwy81129在2009-8-22 17:03:00的发言：

感谢感谢版主了，

可MsgBox太长了，下面的我还没有方法看见，所以请老师让变量sMsg每一行放在一单元格，请老师再赐教。我只能放到一个单元格里，但浏览很有问题，所以请老师一定再帮助赐教下

 

 

没有办法看见，请老师赐教下怎么把宏的名字直接写在表里。

 

谢谢。

 

八月的梦游者

很久没来了。
Sub mmm()
    Dim i As Long, j As Integer
    Dim lngType As Long
    Dim strProc As String
    Dim wb As Workbook
    Dim vbcom As VBComponent
    
    Set wb = ActiveWorkbook

    Cells(1, 1) = wb.Name
    j = 2
    For Each vbcom In wb.VBProject.VBComponents
        With vbcom.CodeModule
            For i = 1 To .CountOfLines
                strProc = .ProcOfLine(i, lngType)
                If strProc <> "" Then
                    Cells(j, 1) = .Parent.Name
                    Cells(j, 2) = "Line: " & i
                    If lngType = 0 Then
                        Cells(j, 3) = strProc & "--- Proc"
                    ElseIf lngType = 1 Then
                        Cells(j, 3) = strProc & "--- Let"
                    ElseIf lngType = 2 Then
                        Cells(j, 3) = strProc & "--- Set"
                    ElseIf lngType = 3 Then
                        Cells(j, 3) = strProc & "--- Get"
                    End If
                    i = i + .ProcCountLines(strProc, lngType) - 1
                    j = j + 1
                End If
            Next i
        End With
    Next
End Sub