lior03
12-30-2005, 01:18 PM
hello
i found the following macro at http://www.puremis.net/excel/tips.shtml
i allow the user get a list of vb projects
in a workbook.
my question: how to add a hyperlink to the name of each project in column c so a click on the procedure name will open it.
Option Explicit
'Need the declaration for the following constants or
'check the reference to Microfost Visual Basic for Applications Extensbility x.xx
Const vbext_pp_none As Long = 0
Const vbext_pk_Proc As Long = 0
Dim x As Long
Dim aList()
Sub GetVbProj()
Dim oVBC As Object
Dim Wb As Workbook
x = 2
For Each Wb In Workbooks
For Each oVBC In Workbooks(Wb.Name).VBProject.VBComponents
If Workbooks(Wb.Name).VBProject.Protection = vbext_pp_none Then
Call GetCodeRoutines(Wb.Name, oVBC.Name)
End If
Next
Next
With Sheets.Add
.[A1].Resize(, 3).Value = Array("Workbook", "Module", "Procedure")
.[A2].Resize(UBound(aList, 2), UBound(aList, 1)).Value = _
Application.Transpose(aList)
.Columns("A:C").Columns.AutoFit
End With
End Sub
Private Sub GetCodeRoutines(wbk As String, VBComp As String)
Dim VBCodeMod As Object
Dim StartLine As Long
On Error Resume Next
Set VBCodeMod = Workbooks(wbk).VBProject.VBComponents(VBComp).CodeModule
With VBCodeMod
StartLine = .CountOfDeclarationLines + 1
Do Until StartLine >= .CountOfLines
ReDim Preserve aList(1 To 3, 1 To x - 1)
aList(1, x - 1) = wbk
aList(2, x - 1) = VBComp
aList(3, x - 1) = .ProcOfLine(StartLine, vbext_pk_Proc)
x = x + 1
StartLine = StartLine + .ProcCountLines(.ProcOfLine(StartLine, _
vbext_pk_Proc), vbext_pk_Proc)
If Err Then Exit Sub
Loop
End With
Set VBCodeMod = Nothing
End Sub
thanks
i found the following macro at http://www.puremis.net/excel/tips.shtml
i allow the user get a list of vb projects
in a workbook.
my question: how to add a hyperlink to the name of each project in column c so a click on the procedure name will open it.
Option Explicit
'Need the declaration for the following constants or
'check the reference to Microfost Visual Basic for Applications Extensbility x.xx
Const vbext_pp_none As Long = 0
Const vbext_pk_Proc As Long = 0
Dim x As Long
Dim aList()
Sub GetVbProj()
Dim oVBC As Object
Dim Wb As Workbook
x = 2
For Each Wb In Workbooks
For Each oVBC In Workbooks(Wb.Name).VBProject.VBComponents
If Workbooks(Wb.Name).VBProject.Protection = vbext_pp_none Then
Call GetCodeRoutines(Wb.Name, oVBC.Name)
End If
Next
Next
With Sheets.Add
.[A1].Resize(, 3).Value = Array("Workbook", "Module", "Procedure")
.[A2].Resize(UBound(aList, 2), UBound(aList, 1)).Value = _
Application.Transpose(aList)
.Columns("A:C").Columns.AutoFit
End With
End Sub
Private Sub GetCodeRoutines(wbk As String, VBComp As String)
Dim VBCodeMod As Object
Dim StartLine As Long
On Error Resume Next
Set VBCodeMod = Workbooks(wbk).VBProject.VBComponents(VBComp).CodeModule
With VBCodeMod
StartLine = .CountOfDeclarationLines + 1
Do Until StartLine >= .CountOfLines
ReDim Preserve aList(1 To 3, 1 To x - 1)
aList(1, x - 1) = wbk
aList(2, x - 1) = VBComp
aList(3, x - 1) = .ProcOfLine(StartLine, vbext_pk_Proc)
x = x + 1
StartLine = StartLine + .ProcCountLines(.ProcOfLine(StartLine, _
vbext_pk_Proc), vbext_pk_Proc)
If Err Then Exit Sub
Loop
End With
Set VBCodeMod = Nothing
End Sub
thanks