Hi jeichhold,

Something like this should do the trick:

Sub test()
Dim objRect As Object
Dim sText As String

For Each objRect In Sheets("Sheet1").Rectangles
sText = vbNullString
On Error Resume Next
If Not objRect.Text Is Nothing Then
sText = objRect.Text
End If
On Error GoTo 0
Debug.Print objRect.Name & ": " & sText
Next objRect
End Sub

--
Regards,

Jake Marx
www.longhead.com


[please keep replies in the newsgroup - email address unmonitored]

jeichhold via OfficeKB.com wrote:
Hello,

I am working on extracting data out of an OLE object pasted into
Excel.
After pasting the object into excel I perform an 'ungroup' on it and
it is converted into a collection of shape (or rectangle) objects
with text in them. I am trying to loop through each of these
rectangles sequentially and grab the text out of them. The problem
is that I do not know what the names of the rectangles will be. I
could have "Rectangle 1", "Rectangle 2", and "Rectangle 3." I could
have "Rectangle 225" through "Rectangle 467," or any sequence of
rectangles. Regardless, I want to start with the lowest numbered
rectangle and loop until i'm out of rectangles.

The code I have so far will only work if I know the beginning and
ending rectangle names. In this case I loop through "Rectangle 5"
through "Rectangle 10"

Dim FirstRect, LastRect as Integer
FirstRect = 5
LastRect = 10

For Index = FirstRect To LastRect
ThisRectangle = "rectangle" & " " & Index
msgbox =
Worksheets("sheet1").Shapes(ThisRectangle).TextFra me. Characters.Text
Next Index


How can I change this code to loop sequentially through all
rectangles on the worksheet, no matter what the starting and ending
rectangle numbers are?