Inserting a drawing object into a cell

[RPrinceton]

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

[Tom Ogilvy]

You calculate the dimensions of the rectangle and add it to the worksheet at
a specific location. how is that kludgy?

The code you have for setting the name does nothing except build a string
and therefore the code to set the move attribute may or may not work, and if
it does, it is by accident.

--
Regards,
Tom Ogilvy

"RPrinceton" <[email protected]> wrote
in message news:[email protected]...
>
> 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
>

[RPrinceton]

Tom,
If I place MsgBox(shObj.Name) within the "for" loop, it will display "Rectangle 1",
"Rectangle 2" etc. So I deduced that the
Set shObj = .Parent.Shapes.AddShape(Type:=msoShapeRectangle, _
Left:=.Left + (.Width - rectSz) / 2, _
Top:=.Top + (.Height - rectSz) / 2, _
Width:=rectSz, _
Height:=rectSz)
block of code names the shape. Therefore I built the shape name in statement:
myRect = "Rectangle " & r. I am certainly open to a better method and is the reason I posted.
Regards,
RPrinceton