Create function

sotiris

Registered User.
Local time
Today, 11:44
Joined
Nov 9, 2006
Messages
22
Hello,
I have create a table with three fields.
1st and 2nd field is Single number the 3rd is text,

The function i want to create is to take the text of the
3rd field and convert it to value.

Example for using the function in a Query
Example: 1rst Field 2nd Field 3rd Field 4rth Field
Single Single Text VBA function
L1 L2 Text Value
record1 1 5 L1+L2 6
record2 5 1 2*L1+L2 11
...
...

I want to create a function that calculate the 4rth field taken values
from L1,L2 and the value depending of the 3rd text field.

Can anyone help??

Thanks
 
You can try something like this: -

Code:
Option Explicit
Option Compare Text
Option Base 0


Sub Test()

    MsgBox SolveAnalog("_A + _B", 1, 5)
    MsgBox SolveAnalog("(2 * _A) + _B", 5, 1)
    
    MsgBox SolveAnalog("_A - _B", 1, 5)
    MsgBox SolveAnalog("_A * _B", 2, 5)
    MsgBox SolveAnalog("_A / _B", 10, 3)
    MsgBox SolveAnalog("_A Mod _B", 9, 65)
    MsgBox SolveAnalog("_A ^ _B", 9, 65)
    
    ' C2F
    MsgBox SolveAnalog("(_A * 9 / 5 + 32)", 100)
    ' F2C
    MsgBox SolveAnalog("((_A - 32) * 5 / 9)", 212)
    
End Sub


Public Function SolveAnalog(ParamArray vntArgList() As Variant) As Variant
    Dim intIndex As Integer
    Dim intCount As Integer
    
    On Error GoTo HandleError
    
    For intIndex = 1 To Len(vntArgList(0))
        If Mid$(vntArgList(0), intIndex, 1) = "_" Then intCount = intCount + 1
    Next intIndex
    
    If intCount = UBound(vntArgList) Then
        For intIndex = 1 To UBound(vntArgList)
            vntArgList(0) = Replace(vntArgList(0), "_" & Chr$(64 + intIndex), vntArgList(intIndex))
        Next intIndex
        SolveAnalog = Eval(vntArgList(0))
    Else
        MsgBox intCount & " value arguments are required... " & UBound(vntArgList) & " were passed."
    End If
      
ExitProcedure:
    Exit Function

HandleError:
    MsgBox "Error in SolveAnalog()" & vbNewLine & _
           "Error Number: " & Err.Number & vbNewLine & _
           "Error Description: " & Err.Description
            
    Resume ExitProcedure
      
End Function

Hope that helps.

Regards,
Chris.
 
Thanks for your advice Chris.
 

Users who are viewing this thread

Back
Top Bottom