mortgageman
Well-known Member
- Joined
- Jun 30, 2005
- Messages
- 2,015
I am getting this error in the following code in the call to allroots. It is not clear to me why I should get this error.
Gene, "The Mortgage Man", Klein
Private Sub Go_Click()
Dim a, b, c As Long ' the a,b and c of ax2+bx+c
Dim aos As Double ' Axis Of Symmetry
Dim x1, x2 As Double 'The two roots
Dim determ As Double
Dim line1xarray, line1yarray
Dim y1, y2, y3, y4, y5, y6, y7
Dim currentchart, fname
'Retrieve the Coefficients of the quadratic
a = TextBox1.Value
b = TextBox2.Value
c = TextBox3.Value
'Calculate the Axis of Symmetry
aos = -1 * b / (2 * a)
TextBox4.Value = aos
'Calculate y value of vertex
TextBox5.Value = a * aos ^ 2 + b * aos + c
'Determine if function "holds" or "spills" water
TextBox6.Value = "UP"
If a < 0 Then TextBox6.Value = "DOWN"
'Determine if function is wider or narrower than y=x^2
TextBox7.Value = "WIDER"
If Abs(a) > 1 Then TextBox7.Value = "NARROWER"
'Express in Vertex form
TextBox8.Value = a & "(x-" & aos & ")^2+" & TextBox5.Value
'Make sure that there are no complex roots
determ = b ^ 2 - 4 * a * c
If determ < 0 Then
TextBox12.Value = "The rest is too complex for me"
Exit Sub
End If
'Calculate first root
MsgBox allroots(a, b, c, 0)
x1 = (-b + (b ^ 2 - 4 * a * c) ^ 0.5) / (2 * a)
TextBox10.Value = x1
MsgBox allroots(a, b, c, 1)
'Calculate second root
x2 = (-b - (b ^ 2 - 4 * a * c) ^ 0.5) / (2 * a)
TextBox11.Value = x2
'Express in Intercept form
TextBox9.Value = a & "(x-" & x1 & ")(x-" & x2 & ")"
'Generate the Graph
'First clean up any graphs that may already exist:
Charts.Add
ActiveChart.ChartType = xlXYScatterSmooth
Do Until ActiveChart.SeriesCollection.Count = 0
ActiveChart.SeriesCollection(1).Delete
Loop
'create the arrays for the inputs to the charts
line1xarray = Array(aos - 3, aos - 2, aos - 1, aos, aos + 1, aos + 2, aos + 3)
y1 = a * ((aos - 3) ^ 2) + b * (aos - 3) + c
y2 = a * ((aos - 2) ^ 2) + b * (aos - 2) + c
y3 = (a * ((aos - 1) ^ 2)) + b * (aos - 1) + c
y4 = a * (aos ^ 2) + b * aos + c
y5 = a * ((aos + 1) ^ 2) + b * (aos + 1) + c
y6 = a * ((aos + 2) ^ 2) + b * (aos + 2) + c
y7 = a * ((aos + 3) ^ 2) + b * (aos + 3) + c
line1yarray = Array(y1, y2, y3, y4, y5, y6, y7)
'put on line 1
With ActiveChart.SeriesCollection.NewSeries
.Name = "Line 1"
.XValues = line1xarray
.Values = line1yarray
End With
'put on line 2
With ActiveChart.SeriesCollection.NewSeries
.Name = "Line 2"
.XValues = Array(aos, aos, aos, aos, aos, aos, aos)
.Values = line1yarray
End With
'Title the Chart
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "y=ax^2+bx+c"
End With
'put Horizontal and Vertical Gridline
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
'Write the Chart to the spreadsheet
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
'Write graph to a file and then read it into the UF image
'Set currentchart = Sheets("Sheet1").ChartObjects(Sheets("Sheet1").ChartObjects.Count).Chart
'fname = ThisWorkbook.Path & "\temp.gif"
'currentchart.Export Filename:=fname, Filtername:="GIF"
'Image1.Visible = True
'Image1.Picture = LoadPicture(fname)
End Sub
Private Function q(a As Long, b As Long, c As Long, ByVal xval) As Long
q = a * xval ^ 2 + b * xval + c
End Function
Public Function allroots(a As Long, b As Long, c As Long, posneg As Boolean)
Dim determ As Double
Dim real, img As Double
determ = b ^ 2 - 4 * a * c
If determ < 0 Then
real = -b / (2 * a)
determ = -determ
img = (determ ^ 0.5) / (2 * a)
If (posneg = 0) Then img = -img
allroots = complex(real, img)
Exit Sub
End If
If posneg = 0 Then
allroots = (-b - (b ^ 2 - 4 * a * c) ^ 0.5) / (2 * a)
Else: allroots = (-b + (b ^ 2 - 4 * a * c) ^ 0.5) / (2 * a)
End If
End Function
Gene, "The Mortgage Man", Klein
Private Sub Go_Click()
Dim a, b, c As Long ' the a,b and c of ax2+bx+c
Dim aos As Double ' Axis Of Symmetry
Dim x1, x2 As Double 'The two roots
Dim determ As Double
Dim line1xarray, line1yarray
Dim y1, y2, y3, y4, y5, y6, y7
Dim currentchart, fname
'Retrieve the Coefficients of the quadratic
a = TextBox1.Value
b = TextBox2.Value
c = TextBox3.Value
'Calculate the Axis of Symmetry
aos = -1 * b / (2 * a)
TextBox4.Value = aos
'Calculate y value of vertex
TextBox5.Value = a * aos ^ 2 + b * aos + c
'Determine if function "holds" or "spills" water
TextBox6.Value = "UP"
If a < 0 Then TextBox6.Value = "DOWN"
'Determine if function is wider or narrower than y=x^2
TextBox7.Value = "WIDER"
If Abs(a) > 1 Then TextBox7.Value = "NARROWER"
'Express in Vertex form
TextBox8.Value = a & "(x-" & aos & ")^2+" & TextBox5.Value
'Make sure that there are no complex roots
determ = b ^ 2 - 4 * a * c
If determ < 0 Then
TextBox12.Value = "The rest is too complex for me"
Exit Sub
End If
'Calculate first root
MsgBox allroots(a, b, c, 0)
x1 = (-b + (b ^ 2 - 4 * a * c) ^ 0.5) / (2 * a)
TextBox10.Value = x1
MsgBox allroots(a, b, c, 1)
'Calculate second root
x2 = (-b - (b ^ 2 - 4 * a * c) ^ 0.5) / (2 * a)
TextBox11.Value = x2
'Express in Intercept form
TextBox9.Value = a & "(x-" & x1 & ")(x-" & x2 & ")"
'Generate the Graph
'First clean up any graphs that may already exist:
Charts.Add
ActiveChart.ChartType = xlXYScatterSmooth
Do Until ActiveChart.SeriesCollection.Count = 0
ActiveChart.SeriesCollection(1).Delete
Loop
'create the arrays for the inputs to the charts
line1xarray = Array(aos - 3, aos - 2, aos - 1, aos, aos + 1, aos + 2, aos + 3)
y1 = a * ((aos - 3) ^ 2) + b * (aos - 3) + c
y2 = a * ((aos - 2) ^ 2) + b * (aos - 2) + c
y3 = (a * ((aos - 1) ^ 2)) + b * (aos - 1) + c
y4 = a * (aos ^ 2) + b * aos + c
y5 = a * ((aos + 1) ^ 2) + b * (aos + 1) + c
y6 = a * ((aos + 2) ^ 2) + b * (aos + 2) + c
y7 = a * ((aos + 3) ^ 2) + b * (aos + 3) + c
line1yarray = Array(y1, y2, y3, y4, y5, y6, y7)
'put on line 1
With ActiveChart.SeriesCollection.NewSeries
.Name = "Line 1"
.XValues = line1xarray
.Values = line1yarray
End With
'put on line 2
With ActiveChart.SeriesCollection.NewSeries
.Name = "Line 2"
.XValues = Array(aos, aos, aos, aos, aos, aos, aos)
.Values = line1yarray
End With
'Title the Chart
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "y=ax^2+bx+c"
End With
'put Horizontal and Vertical Gridline
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
'Write the Chart to the spreadsheet
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
'Write graph to a file and then read it into the UF image
'Set currentchart = Sheets("Sheet1").ChartObjects(Sheets("Sheet1").ChartObjects.Count).Chart
'fname = ThisWorkbook.Path & "\temp.gif"
'currentchart.Export Filename:=fname, Filtername:="GIF"
'Image1.Visible = True
'Image1.Picture = LoadPicture(fname)
End Sub
Private Function q(a As Long, b As Long, c As Long, ByVal xval) As Long
q = a * xval ^ 2 + b * xval + c
End Function
Public Function allroots(a As Long, b As Long, c As Long, posneg As Boolean)
Dim determ As Double
Dim real, img As Double
determ = b ^ 2 - 4 * a * c
If determ < 0 Then
real = -b / (2 * a)
determ = -determ
img = (determ ^ 0.5) / (2 * a)
If (posneg = 0) Then img = -img
allroots = complex(real, img)
Exit Sub
End If
If posneg = 0 Then
allroots = (-b - (b ^ 2 - 4 * a * c) ^ 0.5) / (2 * a)
Else: allroots = (-b + (b ^ 2 - 4 * a * c) ^ 0.5) / (2 * a)
End If
End Function