|
Open a userform that lists the names of modules and other vb components. See all or drill down by specifying a pattern with wildcards and/or type.
Click on a name in the list to activate it and see or change its code.
This userform is designed for any VBA-enabled application and was tested in Access, Word, Excel, and PowerPoint.
Userform_FindModule_FRM_FRX_BAS.zip
Zip file with:
Remember to UNBLOCK downloaded files if necessary to remove the Mark of the Web. Here are steps to do that: https://msaccessgurus.com/MOTW_Unblock.htm
After unzipping and unblocking, press Alt-F11 to go to the Visual Basic Editor. From the menu, choose File, Import
After importing both files, there will be 3 more objects. From the menu, Debug, Compile, and Save.
This form is modeless, meaning that you can interact with other objects while it is open. You won't see a task for it on the Windows taskbar. It will be wherever it opened, or where you dragged it to. It doesn't close until you specifically close it.
If you type something in the pattern without using wildcards *, ?, or # then your pattern gets * added to the beginning and end. Your pattern can include brackets specifying single characters to include or omit.
Component Types are:
Option Explicit Option Compare Text 'upper=lower case '*************** Code Start ***************************************************** ' code behind userform: uform_FindModule_s4p '------------------------------------------------------------------------------- ' Purpose : List component including module names for VBA project ' in a listbox control ' filter name by pattern using Wildcards ' activate selected module in VBE ' Author : crystal (strive4peace) ' This tool: https://msaccessgurus.com/tool/userform_FindModule_s4p.htm ' LICENSE : ' You may freely use and share this code, but not sell it. ' Keep attribution. Mark modifications. Use at your own risk. '------------------------------------------------------------------------------ ' to Run! '------------------------------------------------------------------------------ ' 1. in the Project Explorer, select: uform_FindModule_s4p ' press F5 to Run! ' or from the menu, choose Run, Run Sub/UserForm ' OR 2. in VBA or Immediate window: uform_FindModule_s4p.Show '------------------------------------------------------------------------------ ' *** allow access to the VBA project '----------------------------------------------------------------------------- ' Excel, Word, PowerPoint ' File, Options, Trust Center, Trust Center Settings ' Trust Center, Macro Settings ' set: Trust access to the VBA project object model ' Access ' Computer\HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Access\Security.AccessVBOM = 1 '------------------------------------------------------------------------------ ' Module declarations '------------------------------------------------------------------------------ Private masComponent() As String 'component info '----------------------------- pick Early or Late binding 'Early binding for development ' REFERENCE LIBRARY ' Microsoft Visual Basic for Applications Extensibility 5.3 Library 'Private moProject As VBProject 'Private moVBComponent As VBComponent 'Late binding to deploy Private moProject As Object Private moVBComponent As Object Private msApplicationName As String Private mnCountComponent As Long '------------------------------------------------------------------------------ ' UserForm '------------------------------------------------------------------------------ '~~~~~~~~~~~~~~~~~~ UserForm_Initialize Private Sub UserForm_Initialize() 's4p ... 251031 bppt, 4 Access 'populate lst_Module listbox by assigning array to List property 'CALLs ' WriteLabel_Count ' SortStringArray On Error GoTo Proc_Err Dim sLabel As String _ ,sMsg As String _ ,n As Long Dim asType(1 To 5,1 To 2) As String msApplicationName = Application.Name ' --------------------------------------------------------- moProject Set moProject = Application.VBE.ActiveVBProject 'project running this code mnCountComponent = moProject.VBComponents.Count ReDim masComponent(1 To mnCountComponent,1 To 3) '1. component .Name '2. component .Type '3. GetComponentType 'assign Label_NumComponent.Caption Call WriteLabel_Count(mnCountComponent) ' load names into array n = 0 For Each moVBComponent In moProject.VBComponents n = n + 1 With moVBComponent masComponent(n,1) = .Name masComponent(n,2) = .Type masComponent(n,3) = GetComponentType(.Type) End With 'moVBComponent Next moVBComponent ' sort array by name Call SortStringArray2D(masComponent,1) ' populate listbox with results Me.lst_Module.List = masComponent 'Type combo asType(1,1) = 1: asType(1,2) = "Standard Module" asType(2,1) = 2: asType(2,2) = "Class Module" asType(3,1) = 3: asType(3,2) = "Form" asType(4,1) = 11: asType(4,2) = "ActiveX" asType(5,1) = 100: asType(5,2) = "Document" Me.cbo_Type.List = asType Proc_Exit: Exit Sub Proc_Err: sMsg = "ERROR " & Err.Number & " in " & msApplicationName _ & vbCrLf & vbCrLf _ & Err.Description _ & vbCrLf & vbCrLf & sMsg MsgBox sMsg,, " UserForm_Initialize : " & Me.Name Resume Proc_Exit Resume End Sub '~~~~~~~~~~~~~~~~~~ UserForm_Terminate Private Sub UserForm_Terminate() '241102,60820 Set moVBComponent = Nothing Set moProject = Nothing End Sub ' ------------------------------------------------------------------- ' Find selected module to view and edit ' ------------------------------------------------------------------- Private Sub lst_Module_AfterUpdate() '260820 Goto module or component Call GoToModule End Sub Private Function GoToModule() As Boolean '241102,251031,260820 Dim sName As String _ ,nType As Long GoToModule = False With Me.lst_Module If IsNull(.Value) Then Exit Function sName = .Value End With 'show module or component to view and edit With moProject.VBComponents(sName) nType = .Type .Activate If nType = 100 Then 'document (/form/report) .CodeModule.CodePane.Show End If End With GoToModule = True End Function '------------------------------------------------------------------------------ ' show number of components '------------------------------------------------------------------------------ '~~~~~~~~~~~~~~~~~~ WriteLabel_Count Private Sub WriteLabel_Count(pnNumberItems As Long _ ,Optional psLabel As String = "") '241102,251030,260815,20 Dim sLabel As String sLabel = Format(pnNumberItems, "#,###;;\N\o") & " Component" _ & IIf(pnNumberItems <> 1, "s", "") If pnNumberItems <> mnCountComponent Then sLabel = sLabel & " of " _ & Format(mnCountComponent, "#,##0") End If If psLabel <> "" Then sLabel = sLabel & " for " & psLabel End If Me.Label_NumComponent.Caption = sLabel End Sub '------------------------------------------------------------------------------ ' Criteria: Pattern, Type '------------------------------------------------------------------------------ Private Sub cbo_Type_MouseUp(ByVal Button As Integer,ByVal Shift As Integer,ByVal X As Single,ByVal Y As Single) '260819 On Error Resume Next Me.cbo_Type.DropDown End Sub Private Sub cbo_Type_Enter() '260819 On Error Resume Next Me.cbo_Type.DropDown End Sub Private Sub cbo_Type_Change() '260814 Call MakeList_lst_Module End Sub Private Sub txt_Pattern_Change() '260820 Call MakeList_lst_Module End Sub '~~~~~~~~~~~~~~~~~~ cmd_Clear_Click Private Sub cmd_Clear_Click() '241103 s4p,260819 Me.txt_Pattern.Value = Null Me.cbo_Type.Value = Null 'assign combo list to an array Me.lst_Module.List = masComponent 'update label caption for count modules Call WriteLabel_Count(UBound(masComponent)) 'set focus to Pattern control Me.txt_Pattern.SetFocus End Sub '~~~~~~~~~~~~~~~~~~ MakeList_lst_Module Private Function MakeList_lst_Module() As Long '241102...251031,260819,20 'new array for list with module names ' that match pattern and type ' asMatchnames based on masComponent Dim nMatch As Long _ ,n As Long _ ,nType As Long _ ,nTypeComp As Long _ ,sName As String _ ,sPattern As String _ ,bCompare As Boolean _ ,bMatch As Boolean _ ,vLabel As Variant ' , nMaxCount As Long _ Dim asMatchnames() As String Dim anMatchIndex() As Long On Error GoTo Proc_Err MakeList_lst_Module = 0 'nothing in list vLabel = Null bCompare = False With Me.cbo_Type If IsNull(.Value) Then nType = 0 Else nType = .Value bCompare = True vLabel = .Column(1) '"Type: " & End If End With With Me.txt_Pattern sPattern = .Value & "" If Not Len(sPattern) > 0 Then 'no pattern If nType = 0 Then Me.lst_Module.List = masComponent Call WriteLabel_Count(mnCountComponent) Exit Function End If Else 'has a pattern bCompare = True If Not (InStr(sPattern, "*") > 0 _ Or InStr(sPattern, "?") > 0 _ Or InStr(sPattern, "#") > 0) _ Then 'if pattern doesn't have wilcards, add them sPattern = "*" & sPattern & "*" End If vLabel = (vLabel + " AND ") _ & sPattern '" Pattern: " & End If End With If bCompare <> False Then 'bCompare is True 'array to store row number that matches ReDim anMatchIndex(1 To mnCountComponent) 'loop array nMatch+ anMatchIndex(nMatch) = n nMatch = 0 For n = 1 To mnCountComponent bMatch = True 'assume item will be included sName = masComponent(n,1) If nType > 0 Then nTypeComp = masComponent(n,2) If nTypeComp <> nType Then 'no match for Type bMatch = False End If End If If bMatch <> False And _ (sPattern <> "" And Not sName Like sPattern) _ Then 'no match for Pattern or pattern invalid PatternNoMatch: bMatch = False End If If bMatch <> False Then nMatch = nMatch + 1 anMatchIndex(nMatch) = n End If Next n With Me.lst_Module If nMatch > 0 Then 'loop and load matches to asMatchnames ReDim asMatchnames(1 To nMatch,1 To 3) 'anMatchIndex is the row that matches in masComponent For n = 1 To nMatch asMatchnames(n,1) = masComponent(anMatchIndex(n),1) asMatchnames(n,2) = masComponent(anMatchIndex(n),2) asMatchnames(n,3) = masComponent(anMatchIndex(n),3) Next n 'assign new list .List = asMatchnames Else 'clear listbox Me.lst_Module.Clear End If End With Else nMatch = mnCountComponent vLabel = "" Me.lst_Module.List = masComponent End If Call WriteLabel_Count(nMatch,CStr(vLabel)) MakeList_lst_Module = nMatch Proc_Exit: Exit Function Proc_Err: If Err.Number = 93 Then '93 Invalid pattern string Resume PatternNoMatch End If MsgBox Err.Description _ ,, "ERROR " & Err.Number _ & " MakeList_lst_Module" Resume Proc_Exit Resume End Function ' ------------------------------------------------------------------- ' Close ' ------------------------------------------------------------------- Private Sub cmd_Close_Click() '240521 Unload Me End Sub '------------------------------------------------------------------------------- ' SortStringArray2D '------------------------------------------------------------------------------- 'this could be Public Private Sub SortStringArray2D(ByRef psArray() As String _ ,Optional ByVal piSortColumnIndex As Integer = -1 _ ) ' Sort a 2-dimensional string array by specified column ' 240520 strive4peace, ... 240714 stop if done,260820 ' based on bubble-sort code originally written by Brent Spaulding ' PARAMETERs ' psArray -- string array you want to sort ' 1 or 2 dimensions will be considered ' piSortColumnIndex is the column index (2nd dimension) ' in the array to sort by ' if not specified, will be by the first column On Error GoTo Proc_Err Dim asCurrentValue() As String Dim iColumn As Integer _ ,iColumn1 As Integer _ ,iColumn2 As Integer _ ,iRow As Integer _ ,iRow1 As Integer _ ,iRow2 As Integer _ ,iRows As Integer _ ,iLastRow As Integer _ ,iCountSwap As Integer _ ,sValue1 As String _ ,sValue2 As String iRow1 = LBound(psArray,1) 'first row iRow2 = UBound(psArray,1) 'last row iRows = iRow2 - iRow1 + 1 'calculate number of rows iColumn1 = LBound(psArray,2) 'first column iColumn2 = UBound(psArray,2) 'last column iCountSwap = 0 'haven't swapped anything yet If piSortColumnIndex < iColumn1 Then 'sort by first column if lower number specified 'default is -1 piSortColumnIndex = iColumn1 End If If piSortColumnIndex > iColumn2 Then 'sort by last column if higher number specified piSortColumnIndex = iColumn2 End If 'array with current values -- works with one-dimensional arrays too ReDim asCurrentValue(iColumn1 To iColumn2) 'Bubble sort the array if more than 1 row If iRows > 1 Then 'set the last row to compare iLastRow = iRow2 'loop until last row is the first row Do Until iLastRow = iRow1 'loop from first row to next to last row For iRow = iRow1 To iLastRow - 1 'store current value and next value, in Sort Column sValue1 = psArray(iRow,piSortColumnIndex) sValue2 = psArray(iRow + 1,piSortColumnIndex) 'if current is greater than next, then swap them If sValue1 > sValue2 Then 'save current value for each column in array For iColumn = iColumn1 To iColumn2 asCurrentValue(iColumn) = psArray(iRow,iColumn) Next iColumn 'swap value in each column For iColumn = iColumn1 To iColumn2 'assign current values to next row values psArray(iRow,iColumn) = psArray(iRow + 1,iColumn) 'assign next row values to saved values psArray(iRow + 1,iColumn) = asCurrentValue(iColumn) Next iColumn 'count how many swaps made for this pass iCountSwap = iCountSwap + 1 End If 'values swapped Next iRow 'stop the loop if no swaps were made If Not iCountSwap > 0 Then 'all done! Exit Do End If iLastRow = iLastRow - 1 'decrement last row iCountSwap = 0 'reset swap counter Loop ' Until iLastRow = iRow1 End If Proc_Exit: Exit Sub Proc_Err: MsgBox Err.Description _ ,, "ERROR " & Err.Number _ & " SortStringArray2D" Resume Proc_Exit Resume End Sub '------------------------------------------------------------------------------- ' GetComponentType '------------------------------------------------------------------------------- ' Standard Standard module 1 vbext_ct_StdModule, acStandardModule ' Class Class module 2 vbext_ct_ClassModule, acClassModule ' Form Microsoft Form 3 vbext_ct_MSForm ' ActiveX ActiveX Designer 11 vbext_ct_ActiveXDesigner ' Document Document Module 100 vbext_ct_Document Private Function GetComponentType(nVBComponentType As Long) As String '260813,20 Select Case nVBComponentType Case 1: GetComponentType = "Standard Module" Case 2: GetComponentType = "Class Module" Case 3: GetComponentType = "Form" Case 11: GetComponentType = "ActiveX" Case 100: GetComponentType = "Document" Case Else: GetComponentType = nVBComponentType End Select End Function '*************** Code End *****************************************************
Option Compare Text Option Explicit '*************** Code Start ***************************************************** ' module: mod_uform_FindModule_Show '------------------------------------------------------------------------------- ' Purpose : List component including module names for VBA project ' in a listbox control ' filter name by pattern using Wildcards ' activate selected module in VBE ' Author : crystal (strive4peace) ' This tool: https://msaccessgurus.com/tool/userform_FindModule_s4p.htm ' LICENSE : ' You may freely use and share this code, but not sell it. ' Keep attribution. Mark modifications. Use at your own risk. Public Function FindModule_Show() '260820 uform_FindModule_s4p.Show End Function '*************** Code End *****************************************************
Code coloring tags made by Color Code add-in posted on https://msaccessgurus.com/tool/Addin_ColorCode.htm
List property (Microsoft Forms)
Visual Basic Add-in Model reference
Objects (Visual Basic Add-In Model)
Properties (Visual Basic Add-In Model)
Methods (Visual Basic Add-In Model)
Collections (Visual Basic Add-In Model)
Visual Basic user interface help
Events (Visual Basic for Applications)
I originally created this userform to run in Word. My Normal document template in Word has a lot of code. Sometimes, when I'm going to write something new, I think to myself ... I know I wrote some similar code! But I can't find it with Find in the Visual Basic Editor ... or I find too many things for the results to be helpful. With this tool, I'm finding my code again.
After this userform worked in Word, it got imported into a VBA project in Access and had to change a few things to get it to work there. Then tested in Excel and PowerPoint, and added a few comments about running there. Now the binding is late so the Microsoft Visual Basic for Applications Extensibility 5.3 Library doesn't have to be referenced.
Access has a navigation pane where you can filter object names including VBA modules — but you can't use wildcards or go directly to any VB Component. So this is helpful in Access too.
~ crystal