標題:
[發問]
Macro List
[打印本頁]
作者:
PJChen
時間:
2020-4-16 23:24
標題:
Macro List
大大好,
隨著使用VBA的量增加後,有時要找程式的所在,要花好一會兒功夫,
且同一個Module會有多個Sub 名稱
想請問能否將模組中的所有Module & Sub 名稱
依序將Module1.Sub 名稱
Module2.Sub 名稱 ....
把它全部List 在TXT or excel中 ? 方便查找程式?
作者:
quickfixer
時間:
2020-4-17 06:24
回復
1#
PJChen
隨便google就有一堆現成的解答了,這個列出活頁薄中所有的macro name
http://www.vbaexpress.com/kb/getarticle.php?kb_id=398
excel 2016可正常執行
作者:
quickfixer
時間:
2020-4-17 06:47
回復
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可正常執行
作者:
准提部林
時間:
2020-4-17 09:59
[attach]31921[/attach]
作者:
PJChen
時間:
2020-4-17 22:38
回復
4#
准提部林
回復
3#
quickfixer
二位好,
我把程式抓下來想測試,但卡住了,可以幫我看看嗎?
[attach]31927[/attach]
Sub Command1_Click()
' Declare variables to access the Excel workbook.
Dim objXLApp As Excel.Application
Dim objXLWorkbooks As Excel.Workbooks
Dim objXLABC As Excel.Workbook
' Declare variables to access the macros in the workbook.
Dim objProject As VBIDE.VBProject
Dim objComponent As VBIDE.VBComponent
Dim objCode As VBIDE.CodeModule
' Declare other miscellaneous variables.
Dim iLine As Integer
Dim sProcName As String
Dim pk As vbext_ProcKind
' Open Excel, and open the workbook.
Set objXLApp = New Excel.Application
Set objXLWorkbooks = objXLApp.Workbooks
Set objXLABC = objXLWorkbooks.Open("C:\ABC.XLS")
' Empty the list box.
List1.Clear
' Get the project details in the workbook.
Set objProject = objXLABC.VBProject
' Iterate through each component in the project.
For Each objComponent In objProject.VBComponents
' Find the code module for the project.
Set objCode = objComponent.CodeModule
' Scan through the code module, looking for procedures.
iLine = 1
Do While iLine < objCode.CountOfLines
sProcName = objCode.ProcOfLine(iLine, pk)
If sProcName <> "" Then
' Found a procedure. Display its details, and then skip
' to the end of the procedure.
List1.AddItem objComponent.Name & vbTab & sProcName
iLine = iLine + objCode.ProcCountLines(sProcName, pk)
Else
' This line has no procedure, so go to the next line.
iLine = iLine + 1
End If
Loop
Set objCode = Nothing
Set objComponent = Nothing
Next
Set objProject = Nothing
' Clean up and exit.
objXLABC.Close
objXLApp.Quit
End Sub
複製代碼
作者:
quickfixer
時間:
2020-4-18 00:06
本帖最後由 quickfixer 於 2020-4-18 00:14 編輯
回復
5#
PJChen
網址內的microsoft連結不是有說明?需先設定引用項目
Microsoft Visual Basic for Applications Extensibility 5.3
打勾
[attach]31929[/attach]
第一個code 裡面也有說明要引用
[attach]31928[/attach]
不然把第一個code裡面的這2行
On Error Resume Next
ThisWorkbook.VBProject.References.AddFromGuid _
"{0002E157-0000-0000-C000-000000000046}", 5, 3
加到第二個code裡面最前面,可以改成用程式碼自動引用
作者:
n7822123
時間:
2020-5-18 20:58
本帖最後由 n7822123 於 2020-5-18 21:02 編輯
回復
1#
PJChen
了解VBE架構就不難寫........基本上你應該只想要用而已
所以我不多做解釋，想了解請按 "
F1
"
Sub 找巨集名稱()
Application.DisplayAlerts = False
[A1] = "活頁簿名稱"
[B1] = "模組名稱"
[C1] = "程序名稱"
R = 2
For Each wb In Workbooks
For Each VBC In wb.VBProject.VBComponents
Select Case VBC.Type
Case 1 '1=一般模組
LS = VBC.CodeModule.CountOfLines
'Debug.Print LS
LineStr = VBC.CodeModule.Lines(1, LS)
Lines = Split(LineStr, vbCrLf)
For Each Line In Lines
If Line Like "Sub*" Then
Cells(R, 1) = wb.Name
Cells(R, 2) = VBC.Name
Cells(R, 3) = Line
R = R + 1
End If
Next 'Line
Case Else
End Select
Next 'VBC
Next 'wb
Columns.AutoFit
End Sub
複製代碼
[attach]32046[/attach]
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)
