Hi Everyone,
I am attempting to insert a small rectangle in a column of cells.
I have searched this forum and have found some examples but have run
into problems when attempting
to use them as illustrated. I managed to cobble together this block of
code included below.
Although it works i.e., it places a small rectangle centered in the
cells in rows 1 thru 10,
column 1, it seems border line kludgy and I have to believe there is a
better way.
Please advise. Thx in advance.
RPrinceton

Dim r as integer
Dim c as integer
Dim shObj as Object
Dim myRect as String
Dim rectSZ as Integer
c = 1
For r = 1 To 10
With Worksheets(1).Cells(r, c)
Set shObj = .Parent.Shapes.AddShape(Type:=msoShapeRectangle, _
Left:=.Left + (.Width -
rectSz) / 2, _
Top:=.Top + (.Height -
rectSz) / 2, _
Width:=rectSz, _
Height:=rectSz)
End With
myRect = "Rectangle " & r ' give rectangle a name
ActiveSheet.Shapes(myRect).Placement = xlMove ' insert rectangle into
cell
Next r


--
RPrinceton
------------------------------------------------------------------------
RPrinceton's Profile: http://www.excelforum.com/member.php...fo&userid=2493
View this thread: http://www.excelforum.com/showthread...hreadid=377465