[¤À¨É] VBA¥i¥H¥Î¨ÓÅã¥Ü¥Ø«e¸Ó¥¨¶°¦s©ñ¦b­þ­Ó¼Ò²Õ¤º

shaokui123

Åýµ{§Ç¦Û¤v¥h§ì¸Ó¥¨¶°¦s©ñªº¼Ò²Õ»Pµ{§Ç¦WºÙ

' À˵ø => ¨ú®øÁôÂõøµ¡ => ­Ó¤H¥¨¶°¬¡­¶Ã¯ : PERSONAL.XLSB
' ¤u¨ã:³]©w¤Þ¥Î¶µ¥Ø "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

' Module : Type = 1
¥u§ì"¼Ò²Õ"¤ºªº
¥h°£ If wb.VBProject.VBComponents(K).Type = 1 Then

shaokui123

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