[發問] Macro List

PJChen

大大好,

隨著使用VBA的量增加後,有時要找程式的所在,要花好一會兒功夫,
且同一個Module會有多個Sub 名稱
想請問能否將模組中的所有Module & Sub 名稱
依序將Module1.Sub 名稱
Module2.Sub 名稱 ....
把它全部List 在TXT or excel中 ? 方便查找程式?

quickfixer

回復 1# PJChen

隨便google就有一堆現成的解答了,這個列出活頁薄中所有的macro name
http://www.vbaexpress.com/kb/getarticle.php?kb_id=398
excel 2016可正常執行

quickfixer

回復 1# PJChen

這個列出其它檔案的 macro name 含 module name
https://superuser.com/questions/1365898/macro-vba-code-to-list-and-print-names-and-code-of-all-macros-in-a-workbook
要userform、commandbutton、listbox
其中 objXLABC.Close 要改成objXLABC.Close False,不然程式會卡住
excel 2016可正常執行

准提部林

下載 (7.96 KB)

2020-4-17 09:59

PJChen

回復 4# 准提部林
回復 3# quickfixer
二位好,
我把程式抓下來想測試,但卡住了,可以幫我看看嗎?

下載 (11.73 KB)

2020-4-17 22:38

1. Sub Command1_Click()
   
2.     ' Declare variables to access the Excel workbook.
   
3.     Dim objXLApp As Excel.Application
   
4.     Dim objXLWorkbooks As Excel.Workbooks
   
5.     Dim objXLABC As Excel.Workbook
   
6. 
   
7.     ' Declare variables to access the macros in the workbook.
   
8.     Dim objProject As VBIDE.VBProject
   
9.     Dim objComponent As VBIDE.VBComponent
   
10.     Dim objCode As VBIDE.CodeModule
    
11. 
    
12.     ' Declare other miscellaneous variables.
    
13.     Dim iLine As Integer
    
14.     Dim sProcName As String
    
15.     Dim pk As vbext_ProcKind
    
16. 
    
17.     ' Open Excel, and open the workbook.
    
18.     Set objXLApp = New Excel.Application
    
19.     Set objXLWorkbooks = objXLApp.Workbooks   
    
20.     Set objXLABC = objXLWorkbooks.Open("C:\ABC.XLS")
    
21. 
    
22.     ' Empty the list box.
    
23.     List1.Clear
    
24. 
    
25.     ' Get the project details in the workbook.
    
26.     Set objProject = objXLABC.VBProject
    
27. 
    
28.     ' Iterate through each component in the project.
    
29.     For Each objComponent In objProject.VBComponents
    
30. 
    
31.         ' Find the code module for the project.
    
32.         Set objCode = objComponent.CodeModule
    
33. 
    
34.         ' Scan through the code module, looking for procedures.
    
35.         iLine = 1
    
36.         Do While iLine < objCode.CountOfLines
    
37.             sProcName = objCode.ProcOfLine(iLine, pk)
    
38.             If sProcName <> "" Then
    
39.                 ' Found a procedure. Display its details, and then skip
    
40.                 ' to the end of the procedure.
    
41.                 List1.AddItem objComponent.Name & vbTab & sProcName
    
42.                 iLine = iLine + objCode.ProcCountLines(sProcName, pk)
    
43.             Else
    
44.                 ' This line has no procedure, so go to the next line.
    
45.                 iLine = iLine + 1
    
46.             End If
    
47.         Loop
    
48.         Set objCode = Nothing
    
49.         Set objComponent = Nothing
    
50.     Next
    
51. 
    
52.     Set objProject = Nothing
    
53. 
    
54.     ' Clean up and exit.
    
55.     objXLABC.Close
    
56.     objXLApp.Quit
    
57. End Sub

複製代碼

quickfixer

回復 5# PJChen


網址內的microsoft連結不是有說明?需先設定引用項目
Microsoft Visual Basic for Applications Extensibility 5.3
打勾
   

下載 (57.61 KB)

2020-4-18 00:05

第一個code 裡面也有說明要引用

下載 (67.98 KB)

2020-4-18 00:03

不然把第一個code裡面的這2行
On Error Resume Next
    ThisWorkbook.VBProject.References.AddFromGuid _
    "{0002E157-0000-0000-C000-000000000046}", 5, 3
加到第二個code裡面最前面,可以改成用程式碼自動引用

n7822123

回復 1# PJChen


了解VBE架構就不難寫........基本上你應該只想要用而已

所以我不多做解釋，想了解請按 "F1"

1. Sub 找巨集名稱()
   
2. 
   
3. Application.DisplayAlerts = False
   
4. 
   
5. [A1] = "活頁簿名稱"
   
6. [B1] = "模組名稱"
   
7. [C1] = "程序名稱"
   
8. 
   
9. R = 2
   
10. For Each wb In Workbooks
    
11.   For Each VBC In wb.VBProject.VBComponents
    
12.     Select Case VBC.Type
    
13.       Case 1  '1=一般模組
    
14.         LS = VBC.CodeModule.CountOfLines
    
15.         'Debug.Print LS
    
16.         LineStr = VBC.CodeModule.Lines(1, LS)
    
17.         Lines = Split(LineStr, vbCrLf)
    
18.         For Each Line In Lines
    
19.             If Line Like "Sub*" Then
    
20.               Cells(R, 1) = wb.Name
    
21.               Cells(R, 2) = VBC.Name
    
22.               Cells(R, 3) = Line
    
23.               R = R + 1
    
24.             End If
    
25.         Next 'Line
    
26.       Case Else
    
27.     End Select
    
28.   Next  'VBC
    
29. Next 'wb
    
30. 
    
31. Columns.AutoFit
    
32. 
    
33. End Sub

複製代碼

找巨集名稱.rar (12.46 KB)

下載次數: 4

2020-5-18 20:58