loop through rectangles on worksheet

[jeichhold via OfficeKB.com]

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).TextFrame.
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?

 

[Jake Marx]

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]

 

[Bob Phillips]

One way

Dim oRect As Object

For Each oRect In ActiveSheet.Rectangles
On Error Resume Next
MsgBox oRect.Text
On Error GoTo 0
Next oRect


--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

 

[jeichhold via OfficeKB.com]

Ok, great. I think this will do the trick. thanks

One way

Dim oRect As Object

For Each oRect In ActiveSheet.Rectangles
On Error Resume Next
MsgBox oRect.Text
On Error GoTo 0
Next oRect

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

Hello,

[quoted text clipped - 24 lines]

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?