I'm puzzled on this one, I have a lengthy code that take a set of data and creates a graphic object. I've used it for years in 2003 but with an upgrade to 2010 it errors out.
It goes thru a fair amount of the process, successfully setting up the graph skeleton; axes, titles, size, etc. When it goes to create rectangular objects to represent the proportional data to display it gives me this error - Run-time error '-21407024809 (800700570): The specified value is out of the range.
I've stepped thru, etc and narrowed the problem to the section specified as "Draw Boxes". It doesn't seem to like the value represented by H, when I create an inverse value for H by putting a minus sign on the line specified defining H it will successfully run without error but the resulting graphic image is an inverse of what it should be, graphic boxes drop down from the horizontal axis.
Any ideas or direction would be greatly appreciated.
Thanks,
It goes thru a fair amount of the process, successfully setting up the graph skeleton; axes, titles, size, etc. When it goes to create rectangular objects to represent the proportional data to display it gives me this error - Run-time error '-21407024809 (800700570): The specified value is out of the range.
I've stepped thru, etc and narrowed the problem to the section specified as "Draw Boxes". It doesn't seem to like the value represented by H, when I create an inverse value for H by putting a minus sign on the line specified defining H it will successfully run without error but the resulting graphic image is an inverse of what it should be, graphic boxes drop down from the horizontal axis.
Any ideas or direction would be greatly appreciated.
Thanks,
Rich (BB code):
' CCGraph Macro
' Creates a series of objects that look like a graph but are not actually a excel graph
'
Sub CCGraph()
' Sets Values For Creating Graph
Application.ScreenUpdating = False
Ymin = Range("B2").Value
Ymax = Range("B3").Value
Xmin = Range("B4").Value
Xmax = Range("B5").Value
ChartTopLeftX = Range("B6").Value
ChartTopLeftY = Range("B7").Value
ChartHeight = Range("B8").Value
ChartWidth = Range("B9").Value
Xcolumn = Range("B10").Value
Ycolumn = Range("B11").Value
IDcolumn = Range("B12").Value
StartRow = Range("B13").Value
EndRow = Range("B14").Value
ChartTitle = Range("B15").Value
Ylabel = Range("B16").Value
Xlabel = Range("B17").Value
' Calculate Plot Dimensions
'
PlotTopLeftX = ChartTopLeftX + 50
PlotTopLeftY = ChartTopLeftY + 40
PlotWidth = ChartWidth - 100
PlotHeight = ChartHeight - 90
'
' Calculate Y Reference Line
'
If Ymin >= 0 Then
Yref = PlotTopLeftY + PlotHeight
YrefValue = Ymin
ElseIf Ymax > 0 Then
Yref = PlotTopLeftY + ((Ymax - 0) / (Ymax - Ymin)) * PlotHeight
YrefValue = 0
Else
Yref = PlotTopLeftY + PlotHeight
YrefValue = Ymin
End If
'
' Calculate Ratios
'
Xratio = PlotWidth / (Xmax - Xmin)
Yratio = (PlotTopLeftY - Yref) / (Ymax - YrefValue)
'
' Draw Chart Background
'
ActiveSheet.Rectangles.Add(ChartTopLeftX, ChartTopLeftY, ChartWidth, ChartHeight).Select
Selection.Interior.ColorIndex = 2
'
' Draw Chart Area
'
ActiveSheet.Rectangles.Add(PlotTopLeftX, PlotTopLeftY, PlotWidth, PlotHeight).Select
Selection.Interior.ColorIndex = 2
'
' Chart Title
'
ActiveSheet.TextBoxes.Add(PlotTopLeftX, PlotTopLeftY - 25, PlotWidth, 20).Select
Selection.Border.LineStyle = xlNone
Selection.Interior.ColorIndex = xlNone
Selection.Characters.Text = ChartTitle
Selection.HorizontalAlignment = xlCenter
Selection.Font.FontStyle = "Bold Italic"
Selection.Font.Size = 12
'
' Y Axis Label
'
' following line adjusts the size of the text box
ActiveSheet.TextBoxes.Add(ChartTopLeftX + 5, PlotTopLeftY, 16, PlotHeight).Select
Selection.Border.LineStyle = xlNone
Selection.Interior.ColorIndex = xlNone
Selection.Characters.Text = Ylabel
Selection.VerticalAlignment = xlCenter
Selection.Orientation = xlUpward
Selection.Font.FontStyle = "Bold"
'
' X Axis Label
'
ActiveSheet.TextBoxes.Add(PlotTopLeftX, ChartTopLeftY + ChartHeight - 20, PlotWidth, 14).Select
Selection.Border.LineStyle = xlNone
Selection.Interior.ColorIndex = xlNone
Selection.Characters.Text = Xlabel
Selection.HorizontalAlignment = xlCenter
Selection.Font.FontStyle = "Bold"
'
' Left X Axis Label
'
ActiveSheet.TextBoxes.Add(PlotTopLeftX, ChartTopLeftY + ChartHeight - 20, 90, 14).Select
Selection.Border.LineStyle = xlNone
' Selection.Interior.ColorIndex = 41
Selection.Interior.ColorIndex = xlNone
Selection.Characters.Text = "Committed Volume"
Selection.HorizontalAlignment = xlCenter
Selection.Font.FontStyle = "Bold"
Selection.Font.Size = 8
Selection.Font.ColorIndex = 41
'
'
' Tick Marks and Labels
'
TickCount = 0
Divisions = 10
Ticks = Divisions + 1
Do Until TickCount = Ticks
' Y Ticks
Y = PlotTopLeftY + TickCount * PlotHeight / Divisions
ActiveSheet.Lines.Add(PlotTopLeftX + PlotWidth, Y, PlotTopLeftX - 5, Y).Select
' Y Labels
ActiveSheet.TextBoxes.Add(PlotTopLeftX - 55, Y - 7, 50, 14).Select
Selection.Border.LineStyle = xlNone
Selection.Interior.ColorIndex = xlNone
Ylabel = Round(Ymax - TickCount * (Ymax - Ymin) / Divisions, 0)
Selection.Characters.Text = Ylabel
Selection.HorizontalAlignment = xlRight
' X Ticks
X = PlotTopLeftX + TickCount * PlotWidth / Divisions
ActiveSheet.Lines.Add(X, PlotTopLeftY + PlotHeight, X, PlotTopLeftY + PlotHeight + 5).Select
' X Labels
ActiveSheet.TextBoxes.Add(X - 25, PlotTopLeftY + PlotHeight + 5, 50, 14).Select
Selection.Border.LineStyle = xlNone
Selection.Interior.ColorIndex = xlNone
Xlabel = Round(Xmin + TickCount * (Xmax - Xmin) / Divisions, 0)
Selection.Characters.Text = Xlabel
Selection.HorizontalAlignment = xlCenter
TickCount = TickCount + 1
Loop
'
' Draw Boxes
'
Cux = PlotTopLeftX
Row = StartRow
Do Until Row = EndRow + 1
X = Cux
Y = Yref
cell = Xcolumn & Row
Range(cell).Select
W = Xratio * ActiveCell.Value
cell = Ycolumn & Row
Range(cell).Select
' IF I PUT IN A MINUS SIGN TO GIVE AN INVERSE VALUE IT RUNS WITHOUT ERROR BUT THE GRAPH IMAGE IN REVERSED
H = Yratio * (ActiveCell.Value - YrefValue)
If IDcolumn <> "none" Then
cell = IDcolumn & Row
Range(cell).Select
C = ActiveCell.Value
Else
C = 3
End If
' THIS LINE BELOW TO ADD ERRORS OUT, IT DOESN'T LIKE THE H VALUE
ActiveSheet.Rectangles.Add(X, Y, W, H).Select
Selection.Interior.ColorIndex = C
' Set box border to same as interior
Selection.Border.ColorIndex = C
' Set box border to black
' Selection.Border.ColorIndex = 0
Rows(Row).Select
If IDcolumn <> "none" Then
Selection.Font.ColorIndex = C
Else
Selection.Font.ColorIndex = 1
End If
Cux = Cux + W
Row = Row + 1
Loop
ActiveSheet.DrawingObjects.Select
Selection.Group.Select
Range("C1").Select
Application.ScreenUpdating = True
End Sub
Last edited by a moderator: