This set of procedures will search the VBA modules for all code procedures, even the Private ones!
Then it lists them all, by name, and ask you which one you want. It then displays the one you picked, as much as will fit in a MsgBox and then copies the whole procedure, not just the pre-view just displayed, to the ClipBoard. So, you can then paste it where you want.
All this code goes into a Standard module, like: Module1.
Note: You will need to create a reference to:
"MicroSoft Visual Basic for Applications Extensibilty x.x" for, returning the VBA parts
and for the DataObject: "MicroSoft Forms x.x Object Library" reference!
Do this using the VBA Editor Toolbar: Tools - References.
Public strProcedureNms$, strThisProcedureText$
Function fuc_ModTypeNm(objComponent As VBComponent) As String
'Standard Module code, like: Module1.
Select Case objComponent.Type
Case vbext_ct_ActiveXDesigner
fuc_ModTypeNm = "ActiveX Designer Module"
Case vbext_ct_ClassModule
fuc_ModTypeNm = "Class Module"
Case vbext_ct_Document
fuc_ModTypeNm = "Sheet/Document Module"
Case vbext_ct_MSForm
fuc_ModTypeNm = "MS Form Module"
Case vbext_ct_StdModule
fuc_ModTypeNm = "Standard Module"
Case Else
fuc_ModTypeNm = " Module UnKnown?"
End Select
End Function
Private Sub fs_ListProcedures()
'Standard Module code, like: Module1.
Dim objComponent As VBComponent
Dim VBCodeMod As CodeModule
Dim lngStartLine&
strProcedureNms = ""
For Each objComponent In ActiveWorkbook.VBProject.VBComponents
Set VBCodeMod = ActiveWorkbook.VBProject.VBComponents(objComponent.Name).CodeModule
With VBCodeMod
lngStartLine = .CountOfDeclarationLines + 1
Do Until lngStartLine >= .CountOfLines
strProcedureNms = strProcedureNms & .ProcOfLine(lngStartLine, vbext_pk_Proc) & vbLf
lngStartLine = lngStartLine + _
.ProcCountLines(.ProcOfLine(lngStartLine, _
vbext_pk_Proc), vbext_pk_Proc)
Loop
End With
Next objComponent
End Sub
Private Sub fs_codeToClipBoard()
'Standard module code, like: Module1.
Dim objCodeData As Object
'Note: You will need to create a reference to:
'"MicroSoft Visual Basic for Applications Extensibilty x.x" for, returning the VBA parts
'and for the DataObject: "MicroSoft Forms x.x Object Library" reference!
'Do this using the VBA Editor Toolbar: Tools - References.
Set objCodeData = New DataObject
objCodeData.SetText strThisProcedureText
objCodeData.PutInClipboard
End Sub
Sub DisplayProceedureText()
'Standard Module code, like: Module1.
'Note: You will need to create a reference to MS VBA Extensibilty 5.3
'(in VBE go to Tools>References) to work this code, it was set in this version!
Dim strThisProcedureNm$, strProcNm$, strTestName$
Dim lng1stProcLineNum&, lngProcStartLineNum&, lngThisProcsLineCnt&, lngMyBad&
Dim VBCodeMod As CodeModule
Dim VBComp As VBComponent
Dim booGotOne As Boolean
myAgain:
strThisProcedureText = ""
strProcedureNms = ""
Call fs_ListProcedures
strProcNm = InputBox("To display a procedure's code text," & vbLf & _
"enter its name, from this list, below:" & vbLf & vbLf & _
strProcedureNms, _
"Display a Procedure's Code Lines!")
If strProcNm = "" Then GoTo myEnd
For Each VBComp In ActiveWorkbook.VBProject.VBComponents
Set VBCodeMod = ActiveWorkbook.VBProject.VBComponents(VBComp.Name).CodeModule
lng1stProcLineNum = VBCodeMod.CountOfDeclarationLines + 1
myNextProc:
If lng1stProcLineNum >= VBCodeMod.CountOfLines Then GoTo myNext
strThisProcedureNm = VBCodeMod.ProcOfLine(lng1stProcLineNum, vbext_pk_Proc)
If (strThisProcedureNm = strProcNm And strThisProcedureNm <> "") Then booGotOne = True
strTestName = VBCodeMod.ProcOfLine(lng1stProcLineNum, vbext_pk_Proc)
lng1stProcLineNum = lng1stProcLineNum + _
VBCodeMod.ProcCountLines(VBCodeMod.ProcOfLine(lng1stProcLineNum, _
vbext_pk_Proc), vbext_pk_Proc)
lngProcStartLineNum = VBCodeMod.ProcStartLine(strThisProcedureNm, vbext_pk_Proc)
lngThisProcsLineCnt = VBCodeMod.ProcCountLines(strThisProcedureNm, vbext_pk_Proc)
If booGotOne = True Then
strThisProcedureText = VBCodeMod.Lines(lngProcStartLineNum, lngThisProcsLineCnt)
GoTo myShowIt
Else
GoTo myNextProc
End If
myNext:
Next VBComp
myShowIt:
If InStr(1, strProcedureNms, strProcNm, vbTextCompare) = 0 Then GoTo badNm
Call fs_codeToClipBoard
MsgBox "Note: All of this procedure was sent to the ClipBoard," & vbLf & _
"even if only some is displayed here!" & vbLf & vbLf & _
strThisProcedureText, _
vbInformation + vbOKOnly, _
"Display of: " & "testCodeMacro"
GoTo myEnd
badNm:
lngMyBad = MsgBox("The Procedure name you typed:" & vbLf & vbLf & _
"""" & strProcNm & """" & vbLf & vbLf & _
"Was not fround!" & vbLf & _
"You may have entered an incorrect name?" & vbLf & vbLf & _
"Try Again?", _
vbCritical + vbYesNo, _
"Display Procedure from Module: Error!")
If lngMyBad = 6 Then GoTo myAgain
myEnd:
End Sub
