Insert this code in a module, and then you'll just have to use the 'Calcul' function.
Public Function Calcul(ByVal sExpression As String, _
Optional dVar As Double, Optional iErrNbr As Integer, _
Optional sErrDsc As String) As Double
sExpression (String) : its the mathamatical expression
dVar (Double) : if 'x' is matched in your mathematical expression, you must put his value into dVar. Thus, you can use it to evaluate a mathematical function and draw its graphe
iErrNbr (Integer) : Return the error number if its occured
iErrDsc (Integer) : Return the error description if its occured
i'm sorry but i made my code in french (i don't know english well). you can translate it for me :)
'***********************************************************
'* Code pour l'évaluation d'une expression mathématique : *
'* Conversion d'une expression mathématique de type *
'* String en un reel de type Double *
'* Réalisé par SBAÏ TANJI Aziz *
'***********************************************************
Option Explicit
Private x As Double
Public Function Calcul(ByVal sExpression As String, _
Optional dVar As Double, Optional iErrNbr As Integer, _
Optional sErrDsc As String) As Double
Dim sExpr As String
On Error GoTo Erreur
If IsMissing(dVar) And InStr(1, sExpression, "x", _
vbTextCompare) Then Err.Raise 601, , _
"Paramétre 'dVar' nècessaire"
If Parenthese(sExpression) Then Err.Raise 602, , _
"Expression mal parenthèsée"
x = dVar
Calcul = Somme(IIf(InStr(1, "+-", Left(sExpression, 1)), _
"0" & sExpression, sExpression))
iErrNbr = 0
sErrDsc = ""
Exit Function
Erreur:
'601 : Paramétre 'dVar' nècessaire
'602 : Expression mal parenthèsée
'603 : Erreur de syntaxe
'604 : Erreur de syntaxe
'605 : Valeur en dehors du domaine de définition de la fonction
'606 : Division par zéro
'607 : Nombre négatif élevé à une puissance non entière
Calcul = 0
If Err.Number = 5 Then
iErrNbr = 605
sErrDsc = "Valeur en dehors du domaine de définition de la fonction"
ElseIf Err.Number = 11 Then
iErrNbr = 606
sErrDsc = "Division par zéro"
Else
iErrNbr = Err.Number
sErrDsc = Err.Description
End If
End Function
Private Function Parenthese(sExpression As String) As Integer
Dim i As Integer
Dim iPar As Integer
iPar = 0
For i = 1 To Len(sExpression)
Select Case Mid(sExpression, i, 1)
Case "("
iPar = iPar + 1
Case ")"
iPar = iPar - 1
End Select
If iPar < 0 Then
Parenthese = i
Exit Function
End If
Next i
Parenthese = -iPar
End Function
Private Function Somme(sExpression As String) As Double
Dim iNext As Integer
Dim iL As Integer
iL = Len(sExpression)
iNext = NextOp(sExpression, "+", "-")
If iNext = 1 Or iNext = iL Then
Err.Raise 603, , "Erreur de syntaxe"
ElseIf iNext = 0 Then
Somme = Produit(sExpression)
Else
If Mid(sExpression, iNext, 1) = "+" Then
Somme = Somme(Left(sExpression, iNext - 1)) + _
Produit(Right(sExpression, iL - iNext))
Else
Somme = Somme(Left(sExpression, iNext - 1)) - _
Produit(Right(sExpression, iL - iNext))
End If
End If
End Function
Private Function Produit(sExpression As String) As Double
Dim iNext As Integer
Dim iL As Integer
iL = Len(sExpression)
iNext = NextOp(sExpression, "*", "/")
If iNext = 1 Or iNext = iL Then
Err.Raise 603, , "Erreur de syntaxe"
ElseIf iNext = 0 Then
Produit = Puissance(sExpression)
Else
If Mid(sExpression, iNext, 1) = "*" Then
Produit = Produit(Left(sExpression, iNext - 1)) _
* Puissance(Right(sExpression, iL - iNext))
Else
Produit = Produit(Left(sExpression, iNext - 1)) _
/ Puissance(Right(sExpression, iL - iNext))
End If
End If
End Function
Private Function Puissance(sExpression As String) As Double
Dim iNext As Integer
Dim iL As Integer
Dim i As Integer
Dim iMantisse As Double
Dim iExposant As Double
iL = Len(sExpression)
iNext = NextOp(sExpression, "^", "^")
If iNext = 1 Or iNext = iL Then
Err.Raise 603, , "Erreur de syntaxe"
ElseIf iNext = 0 Then
Puissance = Valeur(sExpression)
Else
iExposant = Valeur(Right(sExpression, iL - iNext))
iMantisse = Puissance(Left(sExpression, iNext - 1))
If iMantisse = 0 Then
Puissance = 0
ElseIf iMantisse > 0 Then
Puissance = Exp(iExposant * Log(iMantisse))
ElseIf Int(iExposant) = iExposant Then
Puissance = 1
For i = 1 To Abs(iExposant)
Puissance = Puissance * iMantisse
Next i
If iExposant < 0 Then Puissance = 1 / Puissance
Else
Err.Raise 607, , "Nombre négatif élevé à " _
& "une puissance non entière."
End If
End If
End Function
Private Function NextOp(sExpression As String, _
Op1 As String, Op2 As String) As Integer
Dim i As Integer
Dim iPar As Integer
Dim sC As String
i = Len(sExpression)
iPar = 0
Do
sC = Mid(sExpression, i, 1)
If (sC = Op1 Or sC = Op2) And iPar = 0 Then
Exit Do
ElseIf sC = "(" Then
iPar = iPar + 1
ElseIf sC = ")" Then
iPar = iPar - 1
End If
i = i - 1
Loop While i > 0
NextOp = i
End Function
Private Function Valeur(sExpression As String) As Double
Dim i As Integer
Dim sC As String
Dim iL As Integer
iL = Len(sExpression)
Select Case Left(sExpression, 1)
Case "("
Valeur = Somme(IIf(InStr(1, "+-", Mid(sExpression, 2, 1)), _
"0" & Mid(sExpression, 2, iL - 2), _
Mid(sExpression, 2, iL - 2)))
Exit Function
Case "x"
If iL = 1 Then
Valeur = x
Else
Err.Raise 604, , "Erreur de syntaxe"
End If
Exit Function
Case "1", "2", "3", "4", "5", "6", "7", _
"8", "9", "0", ".", ","
For i = 1 To iL
sC = Mid(sExpression, i, 1)
If sC = "," Then
sExpression = Left(sExpression, i - 1) _
& "." & Right(sExpression, iL - i)
sC = "."
End If
If (Asc(sC) < 48 Or Asc(sC) > 57) And _
sC <> "." Then
Err.Raise 604, , "Erreur de syntaxe"
Comments