Together with the other routine this gets you nicely in the procedure in the
active cell.
Sub GoToVBELine()
Dim strCell As String
Dim lBracketPos As Long
Dim lSpacePos As Long
Dim strModule As String
Dim lStartLine As Long
strModule = Cells(ActiveCell.Row, 1).Value
strCell = ActiveCell.Value
lBracketPos = InStr(1, strCell, "(", vbTextCompare)
lSpacePos = InStr(lBracketPos, strCell, Chr(32), vbTextCompare)
lStartLine = Val(Mid(strCell, lBracketPos + 1, lSpacePos - (lBracketPos
+ 1)))
With ThisWorkbook.VBProject.VBComponents(strModule).Cod eModule.CodePane
.SetSelection lStartLine, 1, lStartLine, 1
.Show
End With
End Sub
assigned to the key combination Ctrl + Shift + V:
Application.OnKey "^+v", "GoToVBELine"
And this is very helpful.
RBS
"Chip Pearson" wrote in message
...
Do you mean to put the cursor in a particular position in the editor? If
so, use the SetSelection method of the CodePane object. E.g.,
With ThisWorkbook.VBProject.VBComponents("Module1").Cod eModule.CodePane
.SetSelection StartLine, 1, StartLine, 1
End With
--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
"RB Smissaert" wrote in message
...
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