Hello,
Is there a way to list all of the objects on any given sheet? Let's
say I have a command button and a picture on sheet 1, Excel obviously
knows those 2 objects are there, so there must be a code I could write
to find out what objects are on the sheet, or perhaps they are listed
somewhere as sheet properties. If someone can explain how to do this,
I'd appreciate it.

thanks,
Andy

You could loop through all the shapes...

Dim myShape as Shape
dim wks as worksheet

set wks = worksheets("Somesheetnamehere"

for each myshape in wks.shapes
msgbox myshape.name & vblf & myshape.topleftcell.address
next myshape

(Untested, uncompiled. Watch for typos.)

But there are lots of other things that can be shapes, too.

Comments are shapes. Autofilters are shapes.

I'd be much more careful and I'd start by reviewing the notes at Ron de Bruin's
site:
http://www.rondebruin.nl/controlsobjectsworksheet.htm


On 08/28/2011 06:48, Andrew wrote:
Hello,
Is there a way to list all of the objects on any given sheet? Let's
say I have a command button and a picture on sheet 1, Excel obviously
knows those 2 objects are there, so there must be a code I could write
to find out what objects are on the sheet, or perhaps they are listed
somewhere as sheet properties. If someone can explain how to do this,
I'd appreciate it.

thanks,
Andy

--
Dave Peterson

In message of Mon, 29 Aug 2011 06:42:55 in
microsoft.public.excel.programming, Dave Peterson
writes
You could loop through all the shapes...

Dim myShape as Shape
dim wks as worksheet

set wks = worksheets("Somesheetnamehere"

for each myshape in wks.shapes
msgbox myshape.name & vblf & myshape.topleftcell.address
next myshape

(Untested, uncompiled. Watch for typos.)

But there are lots of other things that can be shapes, too.

Comments are shapes. Autofilters are shapes.

I'd be much more careful and I'd start by reviewing the notes at Ron de Bruin's
site:
http://www.rondebruin.nl/controlsobjectsworksheet.htm


On 08/28/2011 06:48, Andrew wrote:
Hello,
Is there a way to list all of the objects on any given sheet? Let's
say I have a command button and a picture on sheet 1, Excel obviously
knows those 2 objects are there, so there must be a code I could write
to find out what objects are on the sheet, or perhaps they are listed
somewhere as sheet properties. If someone can explain how to do this,
I'd appreciate it.

thanks,
Andy


I run Excel 2003.
I had a problem with a change to a particular shape in successive files
from a client. It turned out that x.ActiveSheet.AutoMargins had been
changed from True to False.

This code can be dropped in a stand-alone module. It dumps the shapes on
the active sheet to the Immediate window. I do not cater for overfilling
the Immediate window which is limited to about 200 lines.

Option Explicit

Public Sub ShowShapes() ' Noddy to dump shapes on ActiveSheet
Dim GroupName As String
Dim I As Long, J As Long
Dim O As ShapeRange
Dim S As String
Dim V As Variant
Dim W As Variant

Debug.Print ActiveSheet.Shapes.Count & " shapes"
Debug.Print "Index" & vbTab & Left("Name" & ", ", 12) & _
Left(" Shapetype ", 2 + 20) & _
vbTab & _
Left("Left, Top, Width, Height" & " ", 32) & _
"AM, AS, M(L, T, R, B) Text"
I = 0
For Each V In ActiveSheet.Shapes
I = I + 1
If Not V.Name Like "Group *" Then
Debug.Print ShapeLine(I, 0, V)
Else
GroupName = V.Name
' Can't analyse a group without destroying it
Debug.Print ShapeLine(I, 0, V) & "consists of " & _
V.GroupItems.Count & " items"
Set O = V.Ungroup
J = 0
For Each W In O
J = J + 1: Debug.Print ShapeLine(I, J, W)
Next W
O.Group ' Recreate group
' Restore default name V is destroyed by ungroup
ActiveSheet.Shapes(I).Name = GroupName
End If
Next V
End Sub

Private Function ShapeLine(ByVal Imain As Long, ByVal Isub As Long, _
ByVal V As Shape) As String
ShapeLine = Imain & "." & Left(Isub & " ", 2) & vbTab & _
Left(V.Name & ", ", 12) & " " & _
TXAutoShapeType(V) & vbTab & _
Left(V.Left & ", " & V.Top & ", " & V.Width & ", " & _
V.Height & " ", 32) & _
ShapeText(V)
End Function

Private Function ShapeText(ByVal V As Shape) As String
Dim S As String
Dim I As Long
Dim J As Long

On Error Resume Next
With V.TextFrame
S = IIf(.AutoMargins, "Tr, ", "Fa, ") & _
IIf(.AutoSize, "Tr, ", "Fa, ")
S = S & "M(" & .MarginLeft & "," & .MarginTop & "," & _
.MarginRight & "," & .MarginBottom & ") "
With .Characters.Font
If Err.Number < 0 Then _
Exit Function ' Return empty string if no textframe
On Error GoTo 0 ' Any errors now are fatal
S = S & "Font(" & .FontStyle & ", " & .Name & ", " & _
.Size & "): """
End With
On Error Resume Next
J = .Characters.Count
If Err.Number < 0 Then
On Error GoTo 0 ' Any errors now are fatal
S = S & "NO TEXT"
Else
On Error GoTo 0 ' Any errors now are fatal
' Text limits itself to 255 bytes
For I = 1 To J Step 255
S = S & .Characters(Start:=I).Text
Next I
End If
End With
S = S & """"
ShapeText = S
End Function

Private Function TXAutoShapeType(ByVal x As Shape) As String
Dim S As String

Select Case x.AutoShapeType
Case msoShapeMixed: S = "msoShapeMixed"
Case msoShapeRectangle: S = "msoShapeRectangle"
Case Else
Debug.Print "Untranslated AutoShapeType: " & x.AutoShapeType & _
"."
Debug.Print "cf. x.AutoShapeType in Locals window to get name"
Debug.Assert False ' Force error
End Select
S = Left(S & " ", 20)
TXAutoShapeType = S
End Function
--
Walter Briscoe