[VB] Evaluer une expression mathématique d'un string

En VBA il y a la fonction Evaluate qui prend en argument une formule énoncée dans une variable alphanumérique et renvoi le résultat dans une variable alphanumérique .
En VB, ça n'existe pas, il faut donc l'implémenter soi-même.

j'ai mis cette démo en astuces suite à une question sur le forum, je pense qu'elle peu servir à d'autre
Elle prend en charge les calculs simple +, -, *, et / ainsi que les parenthèses. Les fonctions sont faites de tel façon qu'il est très facile d'ajouter des type tel que Sqr ^ etc..

La démo fonctionne de la même façon que Evaluate, envoi de la formule en alphanumérique , retour du résultat en alphanumérique , type de calcul idem que sur l'image


Cette sub sert uniquement pour le test..

Sub TestCalcul() 
Dim A As String 
Dim Ret As String 
    A = "(((3*(12.223+ 15)) - 7)*21)/7" 
    Ret = Evaluer(A) 
    'Debug.Print Ret 
    '= 224.007 
    A = "((123.32/2.67)*6)+2127.34" 
    Ret = Evaluer(A) 
    '=2404.46359550562 
    'Debug.Print Ret 
End Sub 

Le code des fonctions

Function Evaluer(ByVal Txt As String) As String 
Dim i As Integer, oNB As Integer, fNB As Integer 
Dim P1 As Integer, P2 As Integer 
Dim Buff As String 
Dim T As String 
'Pour les calculs y faut un point à la place de la virgule 
    Txt = Replace(Txt, ",", ".") 
'Voir s'il y a des ( 
    For i = 1 To Len(Txt) 
        If Mid(Txt, i, 1) = "(" Then oNB = oNB + 1 
    Next i 
'S'il y a des ( (ouvrantes), voir si elle sont validée par  des ) (fermantes) 
    If oNB > 0 Then 
        For i = 1 To Len(Txt) 
            If Mid(Txt, i, 1) = ")" Then fNB = fNB + 1 
        Next i 
    Else 
'Pas de parenthèse, Evalue directement le calcul 
        Evaluer = EvalueExpression(Txt) 
        Exit Function 
    End If 
    If oNB <> fNB Then 
'Les parenthèses ne sont pas concordantes, mettre  message erreur parenthèse 
        Exit Function 
    End If 
     
    While oNB > 0 
'recherche la dernière parenthèse ouvrante 
        P1 = InStrRev(Txt, "(") 
'Recherche la parenthèse fermante de l'expression 
        P2 = InStr(Mid(Txt, P1 + 1), ")") 
'Evalue l'expression qui est entre parenthèses 
        Buff = EvalueExpression(Mid(Txt, P1 + 1, P2 - 1)) 
'Remplacer l'expression par le résultat et supprimer les parenthèses 
        Txt = Left(Txt, P1 - 1) & Buff & Mid(Txt, P1 + P2 + 1) 
        oNB = oNB - 1 
    Wend 
'plus de parenthèse, évaluer la dernière expression 
    Evaluer = EvalueExpression(Txt) 

End Function 
Function EvalueExpression(A As String) As String 
Dim T As Integer, S As Integer 
Dim B As String, i As Integer, C As Boolean 
Dim c1 As Double, c2 As Double, Signe As Integer 
Dim R As String, Fin As Boolean, z As Integer 
     
    'enlever les espace 
    A = Replace(A, " ", "") 
     
    While Not Fin 
        For i = 1 To Len(A) 
            T = Asc(Mid(A, i, 1)) 
            If T < 48 And T <> 46 Or i = Len(A) Then 
                If C Then 'évalue 
                    If i = Len(A) Then 
                        c2 = Val(Mid(A, S)) 
                    Else 
                        c2 = Val(Mid(A, S, i - S)) 
                    End If 
                    R = Str(CalculSimple(c1, c2, Signe)) 
                    If i = Len(A) Then 
                        Fin = True 
                    Else 
                        A = Trim(R & Mid(A, i)) 
                        C = False 
                    End If 
                    Exit For 
                Else 'sépare le 1er chiffre 
                    c1 = Val(Left(A, i - 1)) 
                    Signe = T 
                    S = i + 1 
                    C = True 
                End If 
            End If 
        Next i 
    Wend 
    'remplacer l'expression par le résultat 
    EvalueExpression = Trim(R) 
End Function

C'est dans la fonction ci-dessous qu'il est possible d'ajouter des calculs différents

Function CalculSimple(n1 As Double, n2 As Double, Signe As Integer) As Double 
    Select Case Signe 
    Case 43 ' + 
        CalculSimple = n1 + n2 
    Case 45 ' - 
        CalculSimple = n1 - n2 
    Case 42 ' * 
        CalculSimple = n1 * n2 
    Case 47 ' / 
        CalculSimple = n1 / n2 
    'Ici, ajouter d'autre calcul... 
    End Select 
End Function

Note : Pour que cela concorde parfaitement avec une calculatrice il faudrait d'abord évaluer la fonction * et / et seulement ensuite les + et -
Exemple 3+5*7
Une calculatrice aura comme résultat 5*7 = 35 + 3 = 38
Ici cela donnera 3+5=8 *7 = 56
Vous pouvez éventuellement modifier la fonction "EvalueExpression" ou mettre le calcul sous la forme 3+(5*7) qui donnera 38.

Possible qu'il y ai des bugs dans certaines conditions,vous pouvez m'envoyer vos commentaires et ou report d'erreur en MP.