Hello,
I've attached some code that does what you are asking for (at least,
it does what I think you're asking for).
When you said "Rectangle boxes" you are referring to the rectangle
shapes (from the drawing toolbar), which have text in them, correct?
You don't just mean some box which happens to have a rectangular
shape? (sorry if this is confusing). The reason I ask is because this
macro will work for the rectangle shapes from the Drawing toolbar
ONLY. If those 'rectangular boxes' are actually textboxes (which are
rectangular, but not rectangle shapes (as far as Excel is concerned)),
then this macro will not work (although it could be easily modified to
check textboxes).
I apologize if you already knew the distinction, I just wanted to be
clear what the original question was.
I hope this helps.
Sub Rectangular_boxes()
'Response to:
'
http://groups.google.com/group/microsoft.public.excel.programming/
browse_thread/thread/b1edd828c4fa2226/#
'This code works with Rectangles, NOT textboxes
Dim shp As Shape
Dim strShpName As String
Dim shpBoxToCheck As Shape
Dim strBoxToCheck As String
Dim iBoxNumber As Integer
Dim iShapeNumber As Integer
'Which box are we going to get the number out of (in your example, you
said "Rectangle 50")
'If this is going to be the same all the time, you can just use the
following line of code
'strBoxToCheck = "50"
strBoxToCheck = InputBox(Prompt:="Please select the number of the box
that you want to read a value from")
'Loop through all of the shapes in the activesheet
For Each shp In ActiveSheet.Shapes
'Look only at the rectange shapes
If shp.Type = msoAutoShape And shp.AutoShapeType =
msoShapeRectangle Then
'remove "Rectange " from the name so we can see what the
number is
If Replace(shp.Name, "Rectangle ", vbNullString) =
strBoxToCheck Then
Set shpBoxToCheck = shp
'select the shape so we can read the text
'I might be missing some .text or .value property for the
shape
'If there is some property that will let you read the
value without
'selecting the shape, the code will run slightly faster
(and look nicer)
shp.Select
'In case the name can't be converted to an integer, the
macro will exit
On Error Resume Next
iBoxNumber = CInt(Selection.Characters.Text)
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
End If
End If
Next shp
'Loop through all of the shapes again
For Each shp In ActiveSheet.Shapes
If shp.Type = msoAutoShape And shp.AutoShapeType =
msoShapeRectangle Then
iShapeNumber = CInt(Replace(shp.Name, "Rectangle ",
vbNullString))
Select Case iShapeNumber
'If iBoxNumber is 5 and shp refers to "Rectange 4", "4" will
be left in the text area
Case Is < iBoxNumber
shp.Select
Selection.Characters.Text = iShapeNumber
'If iBoxNumber is 5 and shp refers to "Rectange 7", "8" will
be left in the text area
Case Is >= iBoxNumber
shp.Select
Selection.Characters.Text = iShapeNumber + 1
End Select
End If
Next shp
End Sub
