loop through rectangles on worksheet

  • Thread starter Thread starter jeichhold via OfficeKB.com
  • Start date Start date
J

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?
 
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]
 
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)
 
Ok, great. I think this will do the trick. thanks

Bob said:
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,
Click to expand...
[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?
Click to expand...
Click to expand...
 
Back
Top