iT邦幫忙

1

請教VBA有沒有語法可以用來顯示目前該巨集存放在哪個模組內?

如題,因習慣將巨集分類存在個人巨集活頁簿內,可是久了模組內的子資料夾
也變得越來越多了
結果就是真要找時得花一番心力..
加上那個VBE裡的模組字體又無法放大..看了實在有夠傷眼
本來我是都單獨建立在個別巨集下的最後..
用msgbox來顯示巨集存在哪個模組內.
但屬於寫死的方式

所以我再想有沒有方法可以讓程序自己去抓該巨集存放的模組與程序名稱?
如果可以,那語法要怎麼寫呢?謝謝

2 個回答

2
rogeryao
iT邦大師 1 級 ‧ 2021-03-12 12:00:23
最佳解答

請參閱 : Excel 2003 - VBA to get a list of Module names in the project
請參閱 : how to get the list of Function and Sub of a given module name in Excel VBA

' 檢視 => 取消隱藏視窗 => 個人巨集活頁簿 : PERSONAL.XLSB
' 工具:設定引用項目 "Microsoft Visual Basic for Applications Extensibility 5.3"
Private Sub CommandButton1_Click()
GetModules
End Sub

Sub GetModules()
Dim wb As Workbook
Dim K As Long
Dim RowNum As Integer
Set wb = ThisWorkbook

Columns("A:B").Select
Selection.ClearContents
ActiveCell.Select
Cells(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

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

https://ithelp.ithome.com.tw/upload/images/20210312/20085021Sr3Vulnb9r.png

厲害/images/emoticon/emoticon12.gif

不過自身沒有被印出來。

rogeryao iT邦大師 1 級 ‧ 2021-03-12 12:33:23 檢舉

' Module : Type = 1
只抓"模組"內的
去除 If wb.VBProject.VBComponents(K).Type = 1 Then
https://ithelp.ithome.com.tw/upload/images/20210312/20085021KFSTUeT4AW.png

原來如此,我又學到一招了。
感謝。

1
paicheng0111
iT邦高手 1 級 ‧ 2021-03-12 08:34:07
MsgBox Application.VBE.ActiveCodePane.CodeModule

我要發表回答

立即登入回答