- ©«¤l
- 519
- ¥DÃD
- 54
- ºëµØ
- 0
- ¿n¤À
- 595
- ÂI¦W
- 251
- §@·~¨t²Î
- win 10
- ³nÅ骩¥»
- []
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2013-3-19
- ³Ì«áµn¿ý
- 2024-11-18
|
¦^´_ 7# Andy2483
¨ú¥X¦U¼Ò²Õ¤ºªºµ{§Ç¡A¦A°µ¥æ¤e¤ñ¹ï¡C
¦ý¨C¤H¼gµ{¦¡ªº·®æ¤£¦P¡AÀ³¸Ó»Ýn¥t¦æ¦Ò¼{×¹¢©Î¦³¨ä¥L§ó¦nªº°µªk¡C
¥H¤U¬O§Ú¦Û¤v¦¨¥\´ú¸Õ¥Îµ{¦¡¡A ½Ð´ú¸Õ¦Û¤vªº±M®×µ{¦¡¸Õ¸Õ¬Ý¡C
'°Ñ¦Ò https://ithelp.ithome.com.tw/questions/10202519
Option Explicit
Option Base 1
Private Sub GetModules()
Dim wb As Workbook, sh As Worksheet
Dim k&, RowNum%, c
Dim VBC, CodeStrs
Dim arrProc$(), arrB
Set wb = ThisWorkbook
Set sh = Sheets("MacroList") 'µ{§Ç½Õ¥Î¤u§@ªí
sh.Cells.Clear
sh.Select
Range("A1").Select
Set VBC = wb.VBProject.VBComponents
RowNum = 0
ReDim arrProc(5, 1)
For Each c In VBC
RowNum = ListProcedures(c.CodeModule.Name, RowNum, arrProc)
Next
Call µ{§Ç½Õ¥Îªí(arrProc)
'§â¥æ¤e¤lµ{§Ç½Õ¥Îªí©ñ¤J¤u§@ªí "MacroList"
[A1:E1] = Array("¼Ò²Õ¦W", "³Q½Õµ{§Ç¦W", "µ{§ÇÃþ§O", "¼Ò²Õ°_©l¦æ¡A¦æ¼Æ", "½Õ¥Î¼Ò²Õ.µ{§Ç")
'áµ²²Ä¤@¦C Äæ¦ì¦WºÙ
Range("A2").Select
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
[A2].Resize(RowNum, 5) = Application.Transpose(arrProc)
Set wb = Nothing
End Sub
Function ListProcedures(ModuleName$, RowNum%, arrProc) As Integer
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum&, lineStr$, CodeStrs, startLineNum&, endLineNum&
Dim ProcLineCount&, LS&
Dim sh As Worksheet
Dim Rng As Range
Dim ProcName As String
Dim ProcKind As vbext_ProcKind 'µ{§ÇºØÃþ modules, sub( ) or function( ),property get,property Let, property set
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents(ModuleName) 'VBComp ¬O ¼Ò²Õ¦WºÙ¤ºªº¤¸¥ó
Set CodeMod = VBComp.CodeModule
Set sh = ActiveWorkbook.Worksheets("MacroList") '³]©w¤@½Õ¥Îªíªº¤u§@ªí
sh.Select
LS = CodeMod.CountOfLines '³oÓ¼Ò²Õ¤º(©Ò¦³ªºµ{§Ç)µ{¦¡½X»y¥yªº¦æ¼Æ
'¦³¼Ò²Õ¦W¦ý¨S¦³µ{§Ç½X«h¸õ¹L
If LS = 0 Then GoTo ExitFunction
With CodeMod '¦b³oÓ¼Ò²Õ¤º
LineNum = .CountOfDeclarationLines + 1 'µ{§Ç«eªº«Å§i¦C¤Î³Æµù¦C¼Æ
Do Until LineNum >= .CountOfLines 'CountOfLines ¼Ò²Õµ{§Ç½XÁ`¦æ¼Æ
RowNum = RowNum + 1
ReDim Preserve arrProc(5, RowNum)
ProcName = .ProcOfLine(LineNum, ProcKind) 'µ{§Ç¤º¥ô¦ó¦æ½X LineNum ¥i·j´Mµ{§Ç¦WºÙ
arrProc(1, RowNum) = ModuleName: arrProc(2, RowNum) = ProcName: arrProc(3, RowNum) = ProcKindString(ProcKind)
startLineNum = .ProcBodyLine(ProcName, ProcKind) 'µ{§Ç¶}©l¦æ½X
ProcLineCount = .ProcCountLines(ProcName, ProcKind) 'µ{§Ç¦æ¼Æ
' endLineNum = .ProcendLine(ProcName, ProcKind)
arrProc(4, RowNum) = startLineNum & ", " & ProcLineCount
' Cells(RowNum + 1, "D") = startLineNum & ", " & ProcLineCount
LineNum = startLineNum + ProcLineCount + 1 '¦P¤@¼Ò²Õ¤§¤U¤@Óµ{§Ç¶}©l¦æ½X µ{§Ç¶}©l¼Æ + µ{§Çªø«×
Loop
End With
ExitFunction:
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
'°Ñ¦Ò Searching For Text In A Module http://www.cpearson.com/excel/vbe.aspx
Sub µ{§Ç½Õ¥Îªí(arrProc) '(FindWhat$) '·j´M ½Õ¥Îªº¤lµ{§Ç»P¨ç¼Æ¦WºÙ¦r¦ê
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponents
Dim VBC 'As Object
Dim CodeMod As VBIDE.CodeModule
Dim ProcName As String
Dim ButtonStr$ '¦Ûq¥t¦C Command Bar «ö¶s¦r¦ê
Dim ProcKind As VBIDE.vbext_ProcKind 'µ{§ÇºØÃþ modules, sub( ) or function( ),property get,property Let, property set
Dim wb As Workbook
Dim lineStr$, CodeStrs, Proc
Dim i&, j&, RowNum&, comma$
Dim SL&, SL0& ' start line
Dim EL& ' end line
Dim SC&, SC0& ' start column
Dim EC&, EC0& ' end column
Dim Found As Boolean
'¤Þ¥Î¶µ¡G Microsoft Visual Basic for Applications Extensibility 5.3
' AddExtenReference '¥[¤J¤Þ¥Î¶µ
Set wb = ThisWorkbook
Set VBProj = wb.VBProject
Set VBComp = VBProj.VBComponents '(ModuleNames)
For i = 1 To UBound(arrProc, 2)
' Debug.Print arrProc(2, i)
comma = ""
For Each VBC In VBComp
Set CodeMod = VBC.CodeModule
With CodeMod
'¥»¼Ò²Õ¬O§_¦³µ{¦¡½X
If .CountOfLines < 2 Then GoTo next_VBC
'========== ³]©w·j´M°_©lÂI ==========================================================
SC0 = 1 '¤w·j´M¤å¦r¦êªº¤W¤@Ó¦ì¸m
SL = .CountOfDeclarationLines + 1 '±q«Å§i¦æ«áªº²Ä¤@¦æ¶}©l·j´M
EL = .CountOfLines
SC = 0: EC0 = 0: EC = 1023
Found = .Find(Target:=arrProc(2, i), _
startline:=SL, StartColumn:=SC, EndLine:=EL, EndColumn:=EC, _
wholeword:=True, MatchCase:=True, patternsearch:=False)
'¦b¦P¤@¼Ò²Õ¤º¤ÏÂзj´M
Do Until Found = False
If SL = Split(arrProc(4, i), ",")(0) Then GoTo 101 '§ä¨ìªº¬Oµ{§Ç©Î¨ç¼Æ©w¸q¥»¨ªº¦WºÙ
lineStr = Trim(Left(.Lines(SL, 1), SC - 1)) '§ä¨ìªº¦r¦ê«e±ªº¦r¦ê
'¦Ûq¥t¦CCommand Bar «ö¶s¦r¦ê
If InStr(lineStr, "OnAction =") <> 0 Then
ButtonStr = ". " & Replace(Mid(Trim(.Lines(SL - 1, 1)), 12), Chr(34), "") 'len(".caption = ") =11
GoTo 100
End If
' ¦r¦ê¦³ "' "¡B"Sub"¡B "Function"¡B ' "'«h§ä¨ìªº¦r¦ê¥i¯à¤£¬O¦b©I¥sµ{§Ç©Î¬Oµ{§ÇÀY
If InStr(lineStr, Chr(39)) <> 0 Or _
InStr(lineStr, "Sub") <> 0 Or _
InStr(lineStr, "Function") Or _
Right(lineStr, 1) = Chr(34) Then GoTo 101
100
ProcName = .ProcOfLine(SL, ProcKind) '·j´M¨ìªº¦r¦ê¦b¨ºÓ¤lµ{§Ç©Î¨ç¼Æ
If ProcName <> arrProc(2, i) Then
arrProc(5, i) = arrProc(5, i) & comma & .Name & "." & ProcName & ButtonStr
comma = ", ": ButtonStr = ""
End If
'¦b§ä¨ì¦r¦êªº¦P¤@¦æªº¤U¤@Ó¦rÄ~Äò·j´M
EL = .CountOfLines
SC = EC: EC = 1023
GoTo 102
101
'±q¤U¤@¦æªº°_©l¦CÄ~Äò·j´M
SL0 = SL: SL = SL + 1
SC0 = 0: SC = 0
EC0 = 0: EL = .CountOfLines
EC = 1023 '³Ì¦h¤@¦r¦ê¤§©wªø«× 1023Ó¦r
102
Found = .Find(Target:=arrProc(2, i), startline:=SL, StartColumn:=SC, _
EndLine:=EL, EndColumn:=EC, _
wholeword:=True, MatchCase:=True, patternsearch:=False)
Loop
End With
next_VBC:
Next 'Module
Next_i:
Next 'i ,next Procedure being called
End Sub |
|