|
|
Store expressions in a table - Run from Module or QueryQuestionAt present I have a database that is used for mixing various food products.
There are a myraid of formulas that are used in these recipes which is making my
database more and more difficult to follow and maintain. What I would like to do
is simplfy the the use of the formulas by string them in a table, and then
calling from a module. ie.
AnswerDavid, '* ++++ cut here ++++
'*+
' Class module: CCalcFormula
' Purpose: Calculate formulas specified as char strings, e.g.
' Variable3*((Variable1+Variable2)/100)
' Written by: Shamil Salakhetdinov, e-mail: shamil@marta.darts.spb.ru
'*-
Private Const mcstrModuleName As String = "CCalcFormula"
Private mfrm As Form
Private Sub Class_Initialize()
Set mfrm = New Form_frmCalcFormula
mfrm.Visible = False
End Sub
Private Sub Class_Terminate()
If Not mfrm Is Nothing Then
Set mfrm = Nothing
End If
End Sub
Public Property Let VariableN(ByVal vintIdx As Integer, _
ByVal vvarValue As Variant)
mfrm("Variable" & vintIdx) = vvarValue
End Property
Public Property Get Result(ByVal vstrFormula As String) As Variant
mfrm!Result.ControlSource = "=" & vstrFormula
Result = mfrm!Result
End Property
Public Property Get CalcFormula(ByVal vstrFormula As String, _
ParamArray avarArgs() As Variant)
Dim i As Integer
For i = 0 To UBound(avarArgs)
VariableN(i + 1) = avarArgs(i)
Next i
CalcFormula = Result(vstrFormula)
End Property
'*- ------ cut here -------
- copy, paste and run the following test function (this function assumes
that your table with formulas is named tblFormulas and that this table has
the following columns: FormulaName, Formula and Result:
'*+ +++++ cut here +++++++
public sub a_test()
Dim dbs As Database
Dim rst As Recordset
Dim objCalc As New CCalcFormula
Set dbs = CodeDb()
Set rst = dbs.OpenRecordset("tblFormulas", dbOpenDynaset)
While Not rst.EOF
rst.Edit
rst![Result] = objCalc.CalcFormula(rst![Formula], 10.12, 50.76, 20.03)
rst.Update
rst.MoveNext
Wend
end sub
'*- ---------- cut here ------------
A little bit tricky solution but it works and it doesn't need to use Eval(...)
and/or replace functions etc. Copyright © 1999-2008 by Shamil Salakhetdinov. Original version is published here All rights reserved. |