' 檢視 => 取消隱藏視窗 => 個人巨集活頁簿 : PERSONAL.XLSB ' 工具:設定引用項目 "Microsoft Visual Basic for Applications Extensibility 5.3" Private Sub CommandButton1_Click()GetModulesEnd Sub Sub GetModules()Dim wb As WorkbookDim K As Long Dim RowNum As Integer Set wb = ThisWorkbookColumns("A:B").SelectSelection.ClearContentsActiveCell.SelectCells(1, 1) = "Module"Cells(1, 2) = "Sub Or Function"RowNum = 1 For K = 1 To wb.VBProject.VBComponents.Count ' Module : Type = 1 If wb.VBProject.VBComponents(K).Type = 1 Then RowNum = ListProcedures(wb.VBProject.VBComponents(K).Name, RowNum) End If Next Set wb = Nothing End Sub
作者: shaokui123 時間: 2022-7-14 09:20
Function ListProcedures(ModuleName As String, RowNum As Integer) As Integer
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Dim NumLines As Long
Dim WS As Worksheet
Dim Rng As Range
Dim ProcName As String
Dim ProcKind As VBIDE.vbext_ProcKind
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents(ModuleName)
Set CodeMod = VBComp.CodeModule
Set WS = ActiveWorkbook.Worksheets("Sheet1")
With CodeMod
LineNum = .CountOfDeclarationLines + 1
Do Until LineNum >= .CountOfLines
ProcName = .ProcOfLine(LineNum, ProcKind)
RowNum = RowNum + 1
Cells(RowNum, 1) = ModuleName
Cells(RowNum, 2) = ProcName
LineNum = .ProcStartLine(ProcName, ProcKind) + _
.ProcCountLines(ProcName, ProcKind) + 1
Loop
End With
ListProcedures = RowNum
End Function
Function ProcKindString(ProcKind As VBIDE.vbext_ProcKind) As String
Select Case ProcKind
Case vbext_pk_Get
ProcKindString = "Property Get"
Case vbext_pk_Let
ProcKindString = "Property Let"
Case vbext_pk_Set
ProcKindString = "Property Set"
Case vbext_pk_Proc
ProcKindString = "Sub Or Function"
Case Else
ProcKindString = "Unknown Type: " & CStr(ProcKind)
End Select
End Function作者: shaokui123 時間: 2022-7-14 09:24
' Module : Type = 1
只抓"模組"內的
去除 If wb.VBProject.VBComponents(K).Type = 1 Then
