R
RB Smissaert
Wrote the following code from an example from the Chip Pearson site.
Now what I would like is to be able to get to a procedure by pressing a key
combination in the sheet.
I have the module name, the procedure name and the exact starting line of
the procedure.
So with these parameters could I go to the procedure?
Sub ListModules()
Dim VBComp As VBComponent
Dim StartLine As Long
Dim i As Long
Dim n As Long
Dim x As Long
Dim c As Long
Dim LC As Long
Dim LR As Long
Dim sh As Worksheet
MainForm.Repaint
Application.ScreenUpdating = False
For Each sh In ActiveWorkbook.Worksheets
If sh.Name = "Project_Stats" Then
sh.Activate
Exit For
End If
Next
Cells.Clear
Cells(1) = "Module"
Cells(2) = "Module Type"
Cells(3) = "Procedures"
Cells(4) = "Decl. Lines"
Cells(5) = "Code Lines"
Cells(6) = "1 - Procedure names (at line - line count) >>>"
i = 1
For Each VBComp In ThisWorkbook.VBProject.VBComponents
i = i + 1
'module name
'-----------
Cells(i, 1) = VBComp.Name
'module type
'-----------
Cells(i, 2) = CompTypeToName(VBComp)
c = 0
If Not VBComp.Type = vbext_ct_ClassModule Then
With VBComp.CodeModule
StartLine = .CountOfDeclarationLines + 1
Do Until StartLine >= .CountOfLines
c = c + 1
'to get the maximum number of procedures
'to get the width of the table
'---------------------------------------
If (c + 5) > LC And (c + 5) < 257 Then
LC = c + 5
End If
'to correct for blank lines
'--------------------------
x = 0
Do While Len(.Lines(StartLine + x, 1)) < 2
x = x + 1
Loop
'get start line and number of lines of the procedure
'---------------------------------------------------
If 5 + c < 257 Then
Cells(i, 5 + c) = .ProcOfLine(StartLine,
vbext_pk_Proc) & _
" (" & StartLine + x & _
" - " & _
.ProcCountLines(.ProcOfLine(StartLine,
vbext_pk_Proc), vbext_pk_Proc) - x & ")"
End If
'get the name of the procedure
'-----------------------------
StartLine = StartLine + _
.ProcCountLines(.ProcOfLine(StartLine, _
vbext_pk_Proc),
vbext_pk_Proc)
Loop
'number of procedures
'--------------------
Cells(i, 3) = c
End With
End If
'count of declaration lines
'--------------------------
Cells(i, 4) = VBComp.CodeModule.CountOfDeclarationLines
'count of lines in the module
'----------------------------
Cells(i, 5) = VBComp.CodeModule.CountOfLines
Next VBComp
LR = i
For i = 7 To LC
Cells(i) = i - 5
Next
With Range(Cells(1), Cells(LC))
.Font.Bold = True
.HorizontalAlignment = xlLeft
.Interior.ColorIndex = 20
End With
Range(Cells(1), Cells(LR, LC)).Name = "Project_Stats"
With Range("Project_Stats")
.Columns.AutoFit
.Sort Key1:=Cells(5), _
Order1:=xlDescending, _
Key2:=Cells(3), _
Order2:=xlDescending, _
Header:=xlYes
End With
Range(Cells(2, 3), Cells(i, 5)).HorizontalAlignment = xlCenter
For n = 2 To LR
If n Mod 2 = 0 Then
Range(Cells(n, 1), Cells(n, LC)).Interior.ColorIndex = 19
End If
Next
For c = 3 To 5
Cells(LR + 1, c) = WorksheetFunction.Sum(Range(Cells(2, c),
Cells(LR, c)))
Next
ActiveSheet.Name = "Project_Stats"
Application.ScreenUpdating = True
End Sub
Thanks for any advice.
RBS
Now what I would like is to be able to get to a procedure by pressing a key
combination in the sheet.
I have the module name, the procedure name and the exact starting line of
the procedure.
So with these parameters could I go to the procedure?
Sub ListModules()
Dim VBComp As VBComponent
Dim StartLine As Long
Dim i As Long
Dim n As Long
Dim x As Long
Dim c As Long
Dim LC As Long
Dim LR As Long
Dim sh As Worksheet
MainForm.Repaint
Application.ScreenUpdating = False
For Each sh In ActiveWorkbook.Worksheets
If sh.Name = "Project_Stats" Then
sh.Activate
Exit For
End If
Next
Cells.Clear
Cells(1) = "Module"
Cells(2) = "Module Type"
Cells(3) = "Procedures"
Cells(4) = "Decl. Lines"
Cells(5) = "Code Lines"
Cells(6) = "1 - Procedure names (at line - line count) >>>"
i = 1
For Each VBComp In ThisWorkbook.VBProject.VBComponents
i = i + 1
'module name
'-----------
Cells(i, 1) = VBComp.Name
'module type
'-----------
Cells(i, 2) = CompTypeToName(VBComp)
c = 0
If Not VBComp.Type = vbext_ct_ClassModule Then
With VBComp.CodeModule
StartLine = .CountOfDeclarationLines + 1
Do Until StartLine >= .CountOfLines
c = c + 1
'to get the maximum number of procedures
'to get the width of the table
'---------------------------------------
If (c + 5) > LC And (c + 5) < 257 Then
LC = c + 5
End If
'to correct for blank lines
'--------------------------
x = 0
Do While Len(.Lines(StartLine + x, 1)) < 2
x = x + 1
Loop
'get start line and number of lines of the procedure
'---------------------------------------------------
If 5 + c < 257 Then
Cells(i, 5 + c) = .ProcOfLine(StartLine,
vbext_pk_Proc) & _
" (" & StartLine + x & _
" - " & _
.ProcCountLines(.ProcOfLine(StartLine,
vbext_pk_Proc), vbext_pk_Proc) - x & ")"
End If
'get the name of the procedure
'-----------------------------
StartLine = StartLine + _
.ProcCountLines(.ProcOfLine(StartLine, _
vbext_pk_Proc),
vbext_pk_Proc)
Loop
'number of procedures
'--------------------
Cells(i, 3) = c
End With
End If
'count of declaration lines
'--------------------------
Cells(i, 4) = VBComp.CodeModule.CountOfDeclarationLines
'count of lines in the module
'----------------------------
Cells(i, 5) = VBComp.CodeModule.CountOfLines
Next VBComp
LR = i
For i = 7 To LC
Cells(i) = i - 5
Next
With Range(Cells(1), Cells(LC))
.Font.Bold = True
.HorizontalAlignment = xlLeft
.Interior.ColorIndex = 20
End With
Range(Cells(1), Cells(LR, LC)).Name = "Project_Stats"
With Range("Project_Stats")
.Columns.AutoFit
.Sort Key1:=Cells(5), _
Order1:=xlDescending, _
Key2:=Cells(3), _
Order2:=xlDescending, _
Header:=xlYes
End With
Range(Cells(2, 3), Cells(i, 5)).HorizontalAlignment = xlCenter
For n = 2 To LR
If n Mod 2 = 0 Then
Range(Cells(n, 1), Cells(n, LC)).Interior.ColorIndex = 19
End If
Next
For c = 3 To 5
Cells(LR + 1, c) = WorksheetFunction.Sum(Range(Cells(2, c),
Cells(LR, c)))
Next
ActiveSheet.Name = "Project_Stats"
Application.ScreenUpdating = True
End Sub
Thanks for any advice.
RBS