Sheet Information
 

Is it possable to write a list of all the objects within a workbook and any
links that they may have with Macros (subs).

To explain the problem, I have a very important workbook that has been
written over many many years, it now contains about 300 macros running
around 20000 lines of code. Some of these macros are undoubtedly no longer
used, and before I delete any, I wish to check that they are not linked to
any buttons or objects anywhere within the workbook, I can easily check the
modules to see if they are called from other macros however I would like to
check that no button still points to them!

Sheet Information
 

Look at help at the OnAction property.

For activeX objects, these have events and there would be no specific tie to
the object other than through the location and name of the event procudure.
But it sounds like you may not have a lot of this.

--
Regards,
Tom Ogilvy

"Stuart" wrote in message
...
Is it possable to write a list of all the objects within a workbook and
any
links that they may have with Macros (subs).

To explain the problem, I have a very important workbook that has been
written over many many years, it now contains about 300 macros running
around 20000 lines of code. Some of these macros are undoubtedly no longer
used, and before I delete any, I wish to check that they are not linked to
any buttons or objects anywhere within the workbook, I can easily check
the
modules to see if they are called from other macros however I would like
to
check that no button still points to them!

Sheet Information
 

Stuart,

Took me a long time to do it, but here is an app that should do it

Option Explicit

'----------------------------------------------------------------
Sub CheckButtons()
'----------------------------------------------------------------
Dim shp As Shape
Dim sTopLeft As String
Dim fOK As Boolean
Dim i As Long
Dim aryDetails
Dim sMessage As String

ReDim aryDetails(2, 0)
aryDetails(0, i) = "Sheet"
aryDetails(1, i) = "Button"
aryDetails(2, i) = "Routine"

For Each shp In ActiveSheet.Shapes

sTopLeft = ""
On Error Resume Next
sTopLeft = shp.TopLeftCell.Address
'Autofilter and Data Validation dropdowns
'don't seem to have a topleftcell address.
On Error GoTo 0

If shp.Type = msoFormControl Then
If ((shp.FormControlType < xlDropDown) Or _
sTopLeft < "") Then
If shp.OnAction < "" Then
i = UBound(aryDetails, 2) + 1
ReDim Preserve aryDetails(2, i)
aryDetails(0, i) = shp.Parent.Name
aryDetails(1, i) = shp.Name
aryDetails(2, i) = shp.OnAction
End If
End If
ElseIf shp.Type = msoOLEControlObject Then
ActiveXEvents shp, aryDetails
End If

Next shp

For i = LBound(aryDetails, 2) To UBound(aryDetails, 2)
sMessage = sMessage & aryDetails(0, i) & vbTab & _
aryDetails(1, i) & vbTab & _
aryDetails(2, i) & vbCrLf
Next i
MsgBox sMessage

End Sub


'----------------------------------------------------------------
Private Sub ActiveXEvents(ByVal Ctl, ByRef aryDetails)
'----------------------------------------------------------------
Dim aryEvents
Dim i As Long
Dim j As Long

aryEvents = Array("_Activate", "_BeforeDoubleClick", _
"_BeforeRightClick", "_Calculate", _
"_Change", "_FollowHyperlink", _
"_SelectionChange")

j = UBound(aryDetails, 2)

For i = LBound(aryEvents) To UBound(aryEvents)
If ProcedureExists(Ctl.Name & aryEvents(i), Ctl.Parent.CodeName, _
Ctl.Parent.Parent) Then
j = j + 1
ReDim Preserve aryDetails(2, j)
aryDetails(0, j) = Ctl.Parent.Name
aryDetails(1, j) = Ctl.Name
aryDetails(2, j) = Ctl.Name & aryEvents(i)
End If
Next i

End Sub


'----------------------------------------------------------------
Function ModuleExists(ModuleName As String, _
Optional wb As Workbook) As Boolean
'----------------------------------------------------------------
If wb Is Nothing Then
Set wb = ThisWorkbook
End If

On Error Resume Next
ModuleExists = Len( _
wb.VBProject.VBComponents(ModuleName).Name) < 0
End Function


'----------------------------------------------------------------
Function ProcedureExists(ProcedureName As String, _
ModuleName As String, _
Optional wb As Workbook) As Boolean
'----------------------------------------------------------------
If wb Is Nothing Then
Set wb = ThisWorkbook
End If

On Error Resume Next
If ModuleExists(ModuleName) = True Then
ProcedureExists = wb.VBProject.VBComponents(ModuleName) _
.CodeModule.ProcStartLine(ProcedureName, 0) < 0
End If
End Function



--

HTH

RP
(remove nothere from the email address if mailing direct)


"Stuart" wrote in message
...
Is it possable to write a list of all the objects within a workbook and
any
links that they may have with Macros (subs).

To explain the problem, I have a very important workbook that has been
written over many many years, it now contains about 300 macros running
around 20000 lines of code. Some of these macros are undoubtedly no longer
used, and before I delete any, I wish to check that they are not linked to
any buttons or objects anywhere within the workbook, I can easily check
the
modules to see if they are called from other macros however I would like
to
check that no button still points to them!

Sheet Information
 

I don't think that I am explaining what I am after very well so maybe the
following made up code will show you what i am after


range("A1").select
for each object on worksheet
activecell=object.name
activecell.offset(0,1)=object.assignedMacro
activecell.offset(1,0).select
next object



"Tom Ogilvy" wrote in message
...
Look at help at the OnAction property.

For activeX objects, these have events and there would be no specific tie
to
the object other than through the location and name of the event
procudure.
But it sounds like you may not have a lot of this.

--
Regards,
Tom Ogilvy

"Stuart" wrote in message
...
Is it possable to write a list of all the objects within a workbook and
any
links that they may have with Macros (subs).

To explain the problem, I have a very important workbook that has been
written over many many years, it now contains about 300 macros running
around 20000 lines of code. Some of these macros are undoubtedly no
longer
used, and before I delete any, I wish to check that they are not linked
to
any buttons or objects anywhere within the workbook, I can easily check
the
modules to see if they are called from other macros however I would like
to
check that no button still points to them!

Sheet Information
 

You seemed clear enough. That is why I suggested OnAction

Dim obj as Shape

range("A1").select
for each obj in Worksheets("Sheet1").Shapes
activecell=obj.name
On Error Resume Next
activecell.offset(0,1)=Obj.OnAction
On Error goto 0
activecell.offset(1,0).select
next obj


--
Regards,
Tom Ogilvy

"Stuart" wrote in message
...

I don't think that I am explaining what I am after very well so maybe the
following made up code will show you what i am after


range("A1").select
for each object on worksheet
activecell=object.name
activecell.offset(0,1)=object.assignedMacro
activecell.offset(1,0).select
next object



"Tom Ogilvy" wrote in message
...
Look at help at the OnAction property.

For activeX objects, these have events and there would be no specific
tie
to
the object other than through the location and name of the event
procudure.
But it sounds like you may not have a lot of this.

--
Regards,
Tom Ogilvy

"Stuart" wrote in message
...
Is it possable to write a list of all the objects within a workbook
and
any
links that they may have with Macros (subs).

To explain the problem, I have a very important workbook that has been
written over many many years, it now contains about 300 macros running
around 20000 lines of code. Some of these macros are undoubtedly no
longer
used, and before I delete any, I wish to check that they are not
linked
to
any buttons or objects anywhere within the workbook, I can easily
check
the
modules to see if they are called from other macros however I would
like
to
check that no button still points to them!

Sheet Information
 

Works perfectly, many thanks........

stuart


"Tom Ogilvy" wrote in message
...
You seemed clear enough. That is why I suggested OnAction

Dim obj as Shape

range("A1").select
for each obj in Worksheets("Sheet1").Shapes
activecell=obj.name
On Error Resume Next
activecell.offset(0,1)=Obj.OnAction
On Error goto 0
activecell.offset(1,0).select
next obj


--
Regards,
Tom Ogilvy

"Stuart" wrote in message
...

I don't think that I am explaining what I am after very well so maybe
the
following made up code will show you what i am after


range("A1").select
for each object on worksheet
activecell=object.name
activecell.offset(0,1)=object.assignedMacro
activecell.offset(1,0).select
next object



"Tom Ogilvy" wrote in message
...
Look at help at the OnAction property.

For activeX objects, these have events and there would be no specific
tie
to
the object other than through the location and name of the event
procudure.
But it sounds like you may not have a lot of this.

--
Regards,
Tom Ogilvy

"Stuart" wrote in message
...
Is it possable to write a list of all the objects within a workbook
and
any
links that they may have with Macros (subs).

To explain the problem, I have a very important workbook that has
been
written over many many years, it now contains about 300 macros
running
around 20000 lines of code. Some of these macros are undoubtedly no
longer
used, and before I delete any, I wish to check that they are not
linked
to
any buttons or objects anywhere within the workbook, I can easily
check
the
modules to see if they are called from other macros however I would
like
to
check that no button still points to them!

Sheet Information
 

Many thanks bob, works just fine

stuart


"Bob Phillips" wrote in message
...
Stuart,

Took me a long time to do it, but here is an app that should do it

Option Explicit

'----------------------------------------------------------------
Sub CheckButtons()
'----------------------------------------------------------------
Dim shp As Shape
Dim sTopLeft As String
Dim fOK As Boolean
Dim i As Long
Dim aryDetails
Dim sMessage As String

ReDim aryDetails(2, 0)
aryDetails(0, i) = "Sheet"
aryDetails(1, i) = "Button"
aryDetails(2, i) = "Routine"

For Each shp In ActiveSheet.Shapes

sTopLeft = ""
On Error Resume Next
sTopLeft = shp.TopLeftCell.Address
'Autofilter and Data Validation dropdowns
'don't seem to have a topleftcell address.
On Error GoTo 0

If shp.Type = msoFormControl Then
If ((shp.FormControlType < xlDropDown) Or _
sTopLeft < "") Then
If shp.OnAction < "" Then
i = UBound(aryDetails, 2) + 1
ReDim Preserve aryDetails(2, i)
aryDetails(0, i) = shp.Parent.Name
aryDetails(1, i) = shp.Name
aryDetails(2, i) = shp.OnAction
End If
End If
ElseIf shp.Type = msoOLEControlObject Then
ActiveXEvents shp, aryDetails
End If

Next shp

For i = LBound(aryDetails, 2) To UBound(aryDetails, 2)
sMessage = sMessage & aryDetails(0, i) & vbTab & _
aryDetails(1, i) & vbTab & _
aryDetails(2, i) & vbCrLf
Next i
MsgBox sMessage

End Sub


'----------------------------------------------------------------
Private Sub ActiveXEvents(ByVal Ctl, ByRef aryDetails)
'----------------------------------------------------------------
Dim aryEvents
Dim i As Long
Dim j As Long

aryEvents = Array("_Activate", "_BeforeDoubleClick", _
"_BeforeRightClick", "_Calculate", _
"_Change", "_FollowHyperlink", _
"_SelectionChange")

j = UBound(aryDetails, 2)

For i = LBound(aryEvents) To UBound(aryEvents)
If ProcedureExists(Ctl.Name & aryEvents(i), Ctl.Parent.CodeName, _
Ctl.Parent.Parent) Then
j = j + 1
ReDim Preserve aryDetails(2, j)
aryDetails(0, j) = Ctl.Parent.Name
aryDetails(1, j) = Ctl.Name
aryDetails(2, j) = Ctl.Name & aryEvents(i)
End If
Next i

End Sub


'----------------------------------------------------------------
Function ModuleExists(ModuleName As String, _
Optional wb As Workbook) As Boolean
'----------------------------------------------------------------
If wb Is Nothing Then
Set wb = ThisWorkbook
End If

On Error Resume Next
ModuleExists = Len( _
wb.VBProject.VBComponents(ModuleName).Name) < 0
End Function


'----------------------------------------------------------------
Function ProcedureExists(ProcedureName As String, _
ModuleName As String, _
Optional wb As Workbook) As Boolean
'----------------------------------------------------------------
If wb Is Nothing Then
Set wb = ThisWorkbook
End If

On Error Resume Next
If ModuleExists(ModuleName) = True Then
ProcedureExists = wb.VBProject.VBComponents(ModuleName) _
.CodeModule.ProcStartLine(ProcedureName, 0) < 0
End If
End Function



--

HTH

RP
(remove nothere from the email address if mailing direct)


"Stuart" wrote in message
...
Is it possable to write a list of all the objects within a workbook and
any
links that they may have with Macros (subs).

To explain the problem, I have a very important workbook that has been
written over many many years, it now contains about 300 macros running
around 20000 lines of code. Some of these macros are undoubtedly no
longer
used, and before I delete any, I wish to check that they are not linked
to
any buttons or objects anywhere within the workbook, I can easily check
the
modules to see if they are called from other macros however I would like
to
check that no button still points to them!