Inserting a drawing object into a cell
 

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

Inserting a drawing object into a cell
 

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" wrote
in message ...

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

Inserting a drawing object into a cell
 

Tom,
If I place MsgBox(shObj.Name) within the "for" loop, it will displa
"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 i
statement:
myRect = "Rectangle " & r. I am certainly open to a better method an
is the reason I posted.
Regards,
RPrinceto

--
RPrinceto
-----------------------------------------------------------------------
RPrinceton's Profile: http://www.excelforum.com/member.php...nfo&userid=249
View this thread: http://www.excelforum.com/showthread.php?threadid=37746