Trouble Drawing shapes with macros in Excel
 

This macro code works fine to draw an ellipse in a black cell, as long
as the macro is in the same workbook as the active sheet. But, when I
try running from a sheet in a diffferent workbook, it fails with this
message.
"Runtime error: 1004. The specified value is out of range"

Any ideas how I can fix this. It fails at the AddShape Line.

Macro code is below:

Sub nlDrawEllipseInBlackCell()

Dim iTop As Integer ' top of shape
Dim iLeft As Integer ' left edge of shape
Dim iWidth As Integer ' width of shape
Dim iHeight As Integer ' width of shape

' Remember the position, height and width of the selected cell.
iTop = Selection.Top + 1
iLeft = Selection.Left + 2
iWidth = Selection.Width - 4
iHeight = Selection.Height - 3

'Draw the ellipse
ActiveSheet.Shapes.AddShape(msoShapeOval, 365.25, 204.75, 72#,
72#).Select
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 9
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = iHeight ' eg. 11.25
Selection.ShapeRange.Width = iWidth ' eg. 58.5
Selection.ShapeRange.Rotation = 0#

'Move it to the cell
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Top = iTop
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Left = iLeft

End Sub

Trouble Drawing shapes with macros in Excel
 

It worked ok for me.

Any chance that the worksheet is protected or you have worksheets grouped?

SDuguay wrote:

This macro code works fine to draw an ellipse in a black cell, as long
as the macro is in the same workbook as the active sheet. But, when I
try running from a sheet in a diffferent workbook, it fails with this
message.
"Runtime error: 1004. The specified value is out of range"

Any ideas how I can fix this. It fails at the AddShape Line.

Macro code is below:

Sub nlDrawEllipseInBlackCell()

Dim iTop As Integer ' top of shape
Dim iLeft As Integer ' left edge of shape
Dim iWidth As Integer ' width of shape
Dim iHeight As Integer ' width of shape

' Remember the position, height and width of the selected cell.
iTop = Selection.Top + 1
iLeft = Selection.Left + 2
iWidth = Selection.Width - 4
iHeight = Selection.Height - 3

'Draw the ellipse
ActiveSheet.Shapes.AddShape(msoShapeOval, 365.25, 204.75, 72#,
72#).Select
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 9
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = iHeight ' eg. 11.25
Selection.ShapeRange.Width = iWidth ' eg. 58.5
Selection.ShapeRange.Rotation = 0#

'Move it to the cell
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Top = iTop
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Left = iLeft

End Sub

--

Dave Peterson

Trouble Drawing shapes with macros in Excel
 

I found a solution to my problem. I was working with an older Excel97
workbook. I guess there is no inclusion of the Office library because
te problem was that the mso constants were not being recognized. I
looked them up in the object browser and instead now am using the
values themseleves (eg msoShapeOval=9). I figured that out using the
Object Browser (F2 in VBA code screen).

eg. Instead of this: ActiveSheet.Shapes.AddShape(msoShapeOval,
365.25, 204.75, 72#, 72#).Select
I now call: ActiveSheet.Shapes.AddShape(9, 365.25, 204.75, 72#,
72#).Select and also replaced the other mso constants with their
appropriate
values.

I suppose I could opt to include the Office library somehow, perhaps
by resaving the Excel97 file as an Excel2000 file, but what would
happen then if a user not having Office 2000 tried to run this macro?
I figure I'm safer using the actual values rather than the mso
constants.


Dave Peterson wrote in message ...
It worked ok for me.

Any chance that the worksheet is protected or you have worksheets grouped?

SDuguay wrote:

This macro code works fine to draw an ellipse in a black cell, as long
as the macro is in the same workbook as the active sheet. But, when I
try running from a sheet in a diffferent workbook, it fails with this
message.
"Runtime error: 1004. The specified value is out of range"

Any ideas how I can fix this. It fails at the AddShape Line.

Macro code is below:

Sub nlDrawEllipseInBlackCell()

Dim iTop As Integer ' top of shape
Dim iLeft As Integer ' left edge of shape
Dim iWidth As Integer ' width of shape
Dim iHeight As Integer ' width of shape

' Remember the position, height and width of the selected cell.
iTop = Selection.Top + 1
iLeft = Selection.Left + 2
iWidth = Selection.Width - 4
iHeight = Selection.Height - 3

'Draw the ellipse
ActiveSheet.Shapes.AddShape(msoShapeOval, 365.25, 204.75, 72#,
72#).Select
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 9
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = iHeight ' eg. 11.25
Selection.ShapeRange.Width = iWidth ' eg. 58.5
Selection.ShapeRange.Rotation = 0#

'Move it to the cell
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Top = iTop
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Left = iLeft

End Sub