Excel Macro

[eb]

I would like to create a macro that draws a rectangle
with height and dimesions chosen from cells within the
spread sheet. These dimensions will vary and so the size
of the rectangle will vary. I can change the size by
right clicking followed by format autoshape followd by
manually entering the size, also I can change the size by
dragging the corners, but I cannot change the size
automatically by referring to designated cell references.
Can anyone suggest a way.

 

[Bob Umlas]

How about:
Sub rect()
On Error Resume Next
Set Startingcell = Application.InputBox("Enter address of starting cell
for the rectangle", _
default:=ActiveCell.Address, Type:=8)

If Startingcell.Address = "" Then Exit Sub
Set Endingcell = Application.InputBox("Enter address of ending cell for
the rectangle", Type:=8)
If Endingcell.Address = "" Then Exit Sub
'format is left, top, width, height
If Startingcell.Column > 1 Then
leftamt = Range("a1", Startingcell.Offset(, -1)).Width
Else: leftamt = 0
End If
If Startingcell.Row > 1 Then
topamt = Range("a1", Startingcell.Offset(-1)).Height
Else: topamt = 0
End If
Widthamt = Range(Startingcell.Address, Endingcell.Address).Width
Heightamt = Range(Startingcell.Address, Endingcell.Address).Height
ActiveSheet.Rectangles.Add leftamt, topamt, Widthamt, Heightamt
End Sub

 

[eb]

thanks for info will try

-----Original Message-----
How about:
Sub rect()
On Error Resume Next
Set Startingcell = Application.InputBox("Enter address of starting cell
for the rectangle", _
default:=ActiveCell.Address, Type:=8)

If Startingcell.Address = "" Then Exit Sub
Set Endingcell = Application.InputBox("Enter address of ending cell for
the rectangle", Type:=8)
If Endingcell.Address = "" Then Exit Sub
'format is left, top, width, height
If Startingcell.Column > 1 Then
leftamt = Range("a1", Startingcell.Offset(, - 1)).Width
Else: leftamt = 0
End If
If Startingcell.Row > 1 Then
topamt = Range("a1", Startingcell.Offset(- 1)).Height
Else: topamt = 0
End If
Widthamt = Range(Startingcell.Address, Endingcell.Address).Width
Heightamt = Range(Startingcell.Address, Endingcell.Address).Height
ActiveSheet.Rectangles.Add leftamt, topamt, Widthamt, Heightamt
End Sub



.