Programming Tool Box/SIMS_2.iso/code/system/parser/parse.bas

BASIC Source File | 1995-02-27 | 60.6 KB | 797 lines

    Option Explicit
'                                                                                                                                                                                                                                                                                                       '
'                                                                                                                                                                                                                                                                                                        '
'Contient les dΘclarations globales et les routines utilisΘes                                                                                                                                                                                                                                             '
'                                                                                                                                                                                                                                                                                                          '
'                                                                                                                                                                                                                                                                                                           '
    Const NbOperation = 19                   'Nombre d'opΘration possible
    Const NbFonction = 4

    Dim Operation(NbOperation) As String    'Liste des opΘrations disponibles
    Dim Fonction(NbFonction) As String      'Liste des fonctions disponibles
    Dim P(NbOperation) As Integer           'Position des opΘrations

    Const POuv = "("
    Const PFerm = ")"
    Const Virgule = ","
    Const MessageErreur = "Error!"
    Const Guillement = """"

    Dim Literal() As String                 'Liste des litΘraux dans la formule

    Global Intitule() As String                'Liste des variables
    Global NbIntitule As Integer

Function CalculeCondition (F As String) As String
    Dim Valeur1 As String
    Dim Valeur2 As String
    Dim Condition As String

    Dim X1 As Integer
    Dim X2 As Integer
    Dim X As Integer
    Dim I As Integer
    Dim Nouv As Integer
'                                                                                                                                                                                                                                                                                                                       '
'                                                                                                                                                                                                                                                                                                                        '
'Cette procΘdure permet de calculer le rΘsultat d'une condition SI                                                                                                                                                                                                                                                          '
'                                                                                                                                                                                                                                                                                                                          '
'                                                                                                                                                                                                                                                                                                                           '
    F = Trim(F)
    '                                                                                                                                                                                                                                           '
    'On recherche les 3 ΘlΘments constitutifs                                                                                                                                                                                                    '
    '                                                                                                                                                                                                                                             '
    X = 0
    I = 0
    Nouv = 0
    '                                                                                                                                                                                                                                                                                                   '
    'Recherche de la condition                                                                                                                                                                                                                                                                           '
    '                                                                                                                                                                                                                                                                                                     '
    While InStr(X + 1, F, Virgule) <> 0 And I <> -1
        'On a trouvΘ une virgule, on vΘrifie pour voir si le nombre de parenthΦse est correcte                                                                                                                                                                                  '
        I = X
        Do
            X1 = InStr(I + 1, F, POuv)
            X2 = InStr(I + 1, F, PFerm)
            If X1 < X2 And X1 <> 0 And X1 < InStr(X + 1, F, Virgule) Then
                I = X1
                Nouv = Nouv + 1
            ElseIf X2 < InStr(X + 1, F, Virgule) And X2 <> 0 Then
                Nouv = Nouv - 1
                I = X2
            Else
                I = -1
            End If
        Loop Until I = -1
        'On sort de la boucle                                                                                                                                                                                                                   '
        If I = -1 And Nouv = 0 Then
            'On a trouvΘ le bon opΘrande                                                                                                                                                                                                                                                    '
            Condition = Left$(F, InStr(X + 1, F, Virgule) - 1)
            F = Right$(F, Len(F) - InStr(X + 1, F, Virgule))
        Else
            X = InStr(X + 1, F, Virgule)
            I = 0
        End If
    Wend
    If Condition = "" Then CalculeCondition = MessageErreur: Exit Function
    '                                                                                                                                                                                                                                                                                                   '
    'Recherche des deux valeurs                                                                                                                                                                                                                                                                           '
    '                                                                                                                                                                                                                                                                                                     '
    X = 0
    I = 0
    Nouv = 0
    While InStr(X + 1, F, Virgule) <> 0 And I <> -1
        'On a trouvΘ une virgule, on vΘrifie pour voir si le nombre de parenthΦse est correcte                                                                                                                                                                                  '
        I = X
        Do
            X1 = InStr(I + 1, F, POuv)
            X2 = InStr(I + 1, F, PFerm)
            If X1 < X2 And X1 <> 0 And X1 < InStr(X + 1, F, Virgule) Then
                I = X1
                Nouv = Nouv + 1
            ElseIf X2 < InStr(X + 1, F, Virgule) And X2 <> 0 Then
                Nouv = Nouv - 1
                I = X2
            Else
                I = -1
            End If
        Loop Until I = -1
        'On sort de la boucle                                                                                                                                                                                                                   '
        If I = -1 And Nouv = 0 Then
            'On a trouvΘ le bon opΘrande                                                                                                                                                                                                                                                    '
            Valeur1 = Left$(F, InStr(X + 1, F, Virgule) - 1)
            Valeur2 = Right$(F, Len(F) - InStr(X + 1, F, Virgule))
        Else
            X = InStr(X + 1, F, Virgule)
            I = 0
        End If
    Wend
    '                                                                                                                                                                                                                                                   '
    '                                                                                                                                                                                                                                                    '
    'On Θvalue la formule contenue dans la condition                                                                                                                                                                                                      '
    '                                                                                                                                                                                                                                                      '
    '                                                                                                                                                                                                                                                       '

    Condition = CalculeFormule(Condition)
    If Val(Condition) Then
        CalculeCondition = CalculeFormule(Valeur1)
    Else
        If Condition = MessageErreur Then CalculeCondition = Condition: Exit Function
        CalculeCondition = CalculeFormule(Valeur2)
    End If

End Function

Function CalculeFormule (ByVal F As String) As String
    Dim SFDebut As Integer
    Dim SFFin As Integer

    Dim Nouv As Integer
    Dim I As Integer
    Dim J As Integer
    Dim X1 As Integer
    Dim X2 As Integer
    Dim X As Integer
    Dim Y As Integer

    Dim ValeurRetour As Variant
'                                                                                                                                                                                                                                                                   '
'                                                                                                                                                                                                                                                                    '
'Cette procΘdure permet d'Θvaluer la valeur d'une formule en dΘcomposant les sous formules                                                                                                                                                                                                            '
'                                                                                                                                                                                                                                                                      '
'                                                                                                                                                                                                                                                                       '
    'On regarde si commence par un signe                                                                                                                                                                                                                                                            '
    If Left$(F, 1) = "+" Or Left$(F, 1) = "=" Then F = Right$(F, Len(F) - 1)


    '                                                                                                                                                                                                                                                                                       '
    'Boucle de calcul des fonctions                                                                                                                                                                                                                                                   '
    '                                                                                                                                                                                                                                                                                         '
    For I = 1 To NbFonction
        X = InStr(F, Fonction(I))
        While X
            'On controle que le premier caractΦre est bien une parenthΦse                                                                                                                                                                                                                                                   '
            If Left$(Trim$(Right$(F, Len(F) - X + 1 - Len(Fonction(I)))), 1) <> "(" Then CalculeFormule = MessageErreur: Exit Function
            'On recherche l'ensemble de la formule avec les parenthΦses                                                                                                                          '
            Nouv = 0
            SFDebut = InStr(X, F, POuv)
            J = SFDebut
            Do
                X1 = InStr(J + 1, F, POuv)
                X2 = InStr(J + 1, F, PFerm)
                If X1 < X2 And X1 <> 0 Then
                    J = X1
                    Nouv = Nouv + 1
                Else
                    Nouv = Nouv - 1
                    J = X2
                    If X2 = 0 Then
                        Beep
                        MsgBox "Erreur de parenthΦses dans votre formule", 16, "ERREUR"
                        Exit Function
                    End If
                End If
            Loop Until Nouv = -1
            SFFin = J
            'On effectue le calcule de la parenthΦse                                                                                            '
            Select Case I

            Case 1
                'On doit Θvaluer directement le contenu de la prenthΦs eet lui appliquer une fonction                                                                       '
                ValeurRetour = CalculeFormule(Mid$(F, SFDebut + 1, SFFin - SFDebut - 1))
                ValeurRetour = Format(Int(Val(ValeurRetour)))

            Case 2
                ValeurRetour = CalculeFormule(Mid$(F, SFDebut + 1, SFFin - SFDebut - 1))
                ValeurRetour = Format(Abs(Val(ValeurRetour)))

            Case 3
                'On doit rechercher toute une rangΘe de valeur                                                                                                                                                              '
                'On extrait les numΘros de lignes                                                                                                                                                                            '
                ValeurRetour = UCase$(Mid$(F, SFDebut + 1, SFFin - SFDebut - 1))
                If Left$(ValeurRetour, 1) <> "L" Then CalculeFormule = MessageErreur: Exit Function
                ValeurRetour = Right$(ValeurRetour, Len(ValeurRetour) - 1)

                Y = InStr(ValeurRetour, ":")
                If Y = 0 Then CalculeFormule = MessageErreur: Exit Function
                X1 = Val(Left$(ValeurRetour, Y))
                If X1 < 1 Or X1 > 8 Then CalculeFormule = MessageErreur: Exit Function
                ValeurRetour = Right$(ValeurRetour, Len(ValeurRetour) - Y)

                If Left$(ValeurRetour, 1) <> "L" Then CalculeFormule = MessageErreur: Exit Function
                ValeurRetour = Right$(ValeurRetour, Len(ValeurRetour) - 1)
                If Not IsNumeric(ValeurRetour) Then CalculeFormule = MessageErreur: Exit Function
                X2 = Val(ValeurRetour)

                'On effectue la somme                                                                                                                                                                               '
                ValeurRetour = 0
                For J = X1 To X2
                    ValeurRetour = ValeurRetour + Val(Form1.Datas(J))
                Next J

            Case 4
                'C'est la boucle conditionnelle                                                                                                                                                                                                                                                             '
                'On va recherche les valeurs et la condition                                                                                                                                                                                                                                                                                        '
                ValeurRetour = CalculeCondition(Mid$(F, SFDebut + 1, SFFin - SFDebut - 1))
                If ValeurRetour = MessageErreur Then CalculeFormule = MessageErreur: Exit Function

            Case Else

            End Select
            'On modifie la formule F afin d'y intΘgrer le rΘsultat du calcul de la sous formule                                                                                                                                                                                                                                         '
            F = Trim(Left$(F, X - 1) + ValeurRetour + Right$(F, Len(F) - SFFin))
            X = InStr(F, Fonction(I))
        Wend
    Next I



    '                                                                                                                                                                                                                                                                                       '
    'Boucle d'extraction des sous formules                                                                                                                                                                                                                                                   '
    '                                                                                                                                                                                                                                                                                         '
    While InStr(F, POuv) <> 0
        'Il reste une parenthΦse correspondant α une sous formule                                                                                                                                                                                                                                   '
        'On recherche la fin de cette parenthΦse                                                                                                                                                                                                                                                                                '
        Nouv = 0
        SFDebut = InStr(F, POuv)
        I = SFDebut
        Do
            X1 = InStr(I + 1, F, POuv)
            X2 = InStr(I + 1, F, PFerm)
            If X1 < X2 And X1 <> 0 Then
                I = X1
                Nouv = Nouv + 1
            Else
                Nouv = Nouv - 1
                I = X2
                If X2 = 0 Then
                    Beep
                    MsgBox "Erreur de parenthΦses dans votre formule", 16, "ERREUR"
                    Exit Function
                End If
            End If
        Loop Until Nouv = -1
        SFFin = I
        'On modifie la formule F afin d'y intΘgrer le rΘsultat du calcul de la sous formule                                                                                                                                                                                                                                         '
        F = Trim(Left$(F, SFDebut - 1) + CalculeFormule(Mid$(F, SFDebut + 1, SFFin - SFDebut - 1)) + Right$(F, Len(F) - SFFin))
    Wend

    CalculeFormule = ValeurFormule(F)

End Function

Function Formule (ByVal F As String) As String
'                                                                                                                                                                                                                                                               '
'                                                                                                                                                                                                                                                                '
'Retourne la valeur d'une formule. C'est la fonction appelante principale.                                                                                                                                                                                                                                 '
'                                                                                                                                                                                                                                                                  '
'                                                                                                                                                                                                                                                                   '
    'Initialisation                                                                                                                                                                                                                                                                                     '
    F = UCase$(Trim(F))
    If Operation(1) = "" Then InitOperation
    If Not Transformation_Literal(F) Then Formule = MessageErreur: Exit Function

    Formule = CalculeFormule(F)
End Function

Sub InitOperation ()
'                                                                                                                                                                                                                                                                           '
'                                                                                                                                                                                                                                                                            '
'Initialise les opΘrations disponibles                                                                                                                                                                                                                                        '
'                                                                                                                                                                                                                                                                              '
'                                                                                                                                                                                                                                                                               '
    Operation(1) = "^"
    Operation(2) = "*"
    Operation(3) = "/"
    Operation(4) = "MOD"
    Operation(5) = "+"
    Operation(6) = "-"
    Operation(7) = ">="
    Operation(8) = "<="
    Operation(9) = "=>"
    Operation(10) = "=<"
    Operation(11) = "<>"
    Operation(12) = ">"
    Operation(13) = "<"
    Operation(14) = "="
    Operation(15) = "#"
    Operation(16) = "NOT"
    Operation(17) = "AND"
    Operation(18) = "OR"
    Operation(19) = "&"

    Fonction(1) = "INT"
    Fonction(2) = "ABS"
    Fonction(3) = "SUM"
    Fonction(4) = "IF"

    NbIntitule = UBound(Intitule)

End Sub

Sub MoinsParMoins (F As String)
'                                                                                                                                                                           '
'                                                                                                                                                                            '
'Cette procΘdure permet de remttre les signes correctement                                                                                                                    '
'                                                                                                                                                                              '
'                                                                                                                                                                               '
    While InStr(F, "--") <> 0
        F = Left$(F, InStr(F, "--") - 1) + "+" + Right$(F, Len(F) - InStr(F, "--") - 1)
    Wend
    While InStr(F, "++") <> 0
        F = Left$(F, InStr(F, "++") - 1) + "+" + Right$(F, Len(F) - InStr(F, "++") - 1)
    Wend
    While InStr(F, "-+") <> 0
        F = Left$(F, InStr(F, "-+") - 1) + "-" + Right$(F, Len(F) - InStr(F, "-+") - 1)
    Wend
    While InStr(F, "+-") <> 0
        F = Left$(F, InStr(F, "+-") - 1) + "-" + Right$(F, Len(F) - InStr(F, "+-") - 1)
    Wend
End Sub

Sub Operande_Anterieur (X As Integer, F As String, V As Variant, SFDebut As Integer)
    Call Operande_Anterieur_Comparaison(X, F, V, SFDebut)
    Call ValeurOperande(V)
End Sub

Sub Operande_Anterieur_Comparaison (X As Integer, F As String, V As Variant, SFDebut As Integer)
    Dim J As Integer
    Dim Y As Integer
'                                                                                                                                                                   '
'                                                                                                                                                                    '
'Cette procΘdure permet de trouver l'opΘrande antΘrieur                                                                                                               '
'                                                                                                                                                                      '
'                                                                                                                                                                       '
    SFDebut = 0
    Erase P
    For J = 1 To NbOperation
        Y = InStr(P(J) + 1, F, Operation(J))
        Do
            P(J) = Y
            Y = InStr(P(J) + 1, F, Operation(J))
        Loop Until (Y = 0 Or Y >= X)
        If P(J) <> 0 And P(J) > SFDebut And P(J) < X Then SFDebut = P(J) - 1 + Len(Operation(J))
        If J = 6 And P(J) = 1 Then SFDebut = 0
    Next J

    V = Mid$(F, SFDebut + 1, X - SFDebut - 1)

End Sub

Sub Operande_Posterieur (X As Integer, F As String, V As Variant, SFFin As Integer)
    Call Operande_Posterieur_Comparaison(X, F, V, SFFin)
    Call ValeurOperande(V)
End Sub

Sub Operande_Posterieur_Comparaison (X As Integer, F As String, V As Variant, SFFin As Integer)
    Dim J As Integer
    Dim Y As Integer
'                                                                                                                                                                   '
'                                                                                                                                                                    '
'Cette procΘdure permet de trouver l'opΘrande antΘrieur                                                                                                               '
'                                                                                                                                                                      '
'                                                                                                                                                                       '
    F = Trim(F)
    SFFin = Len(F) + 1
    For J = 1 To NbOperation
        Y = InStr(X + 1, F, Operation(J))
        If Y <> 0 And Y < SFFin Then
            If J = 6 Or J = 5 Then
                If Trim$(Mid$(F, X + 1, Y - X - 1)) <> "" Then
                    SFFin = Y
                Else
                    Y = InStr(Y + 1, F, Operation(J))
                    If Y <> 0 And Y < SFFin Then SFFin = Y
                End If
            Else
                SFFin = Y
            End If
        End If
    Next J

    V = Trim$(Mid$(F, X + 1, SFFin - X - 1))
End Sub

Function Signe (X As Integer, F As String) As Integer
    Dim J As Integer
    Dim Y As Integer
    Dim V As Variant
    Dim SFDebut As Integer
'                                                                                                                                                                                                                                   '
'                                                                                                                                                                                                                                    '
'Cette procΘdure permet de dΘterminer si c'est un signe qu'on a trouvΘ                                                                                                                                                                '
'                                                                                                                                                                                                                                      '
'                                                                                                                                                                                                                                       '
    If X = 0 Then Signe = False: Exit Function
    SFDebut = 0
    Erase P
    For J = 1 To NbOperation
        Y = InStr(P(J) + 1, F, Operation(J))
        Do
            P(J) = Y
            Y = InStr(P(J) + 1, F, Operation(J))
        Loop Until (Y = 0 Or Y >= X)
        If P(J) <> 0 And P(J) > SFDebut And P(J) < X Then SFDebut = P(J) - 1 + Len(Operation(J))
        If J = 6 And P(J) = 1 Then SFDebut = 0
    Next J

    V = Mid$(F, SFDebut + 1, X - SFDebut - 1)
    If Trim$(V) = "" Then Signe = True:  Else Signe = False
End Function

Function Transformation_Literal (F As String) As Integer
    Dim SFDebut As Integer
    Dim SFFin As Integer
    Dim N As Integer
'                                                                                                                                                                                                                                                               '
'                                                                                                                                                                                                                                                                '
'Cette procΘdure permet de remplacer les litΘraux dans F                                                                                                                                                                                                          '
'                                                                                                                                                                                                                                                                  '
'                                                                                                                                                                                                                                                                   '
    ReDim Literal(0)

    SFDebut = InStr(F, Guillement)
    While SFDebut
        SFFin = InStr(SFDebut + 1, F, Guillement)
        If SFFin = 0 Then Transformation_Literal = False: Exit Function
        'On rajoute l'ΘlΘment                                                                                                                                                                                   '
        N = N + 1
        ReDim Preserve Literal(N)
        Literal(N) = Mid$(F, SFDebut + 1, SFFin - SFDebut - 1)
        F = Left$(F, SFDebut - 1) + "@" + Format(N) + Right$(F, Len(F) - SFFin)
        SFDebut = InStr(F, Guillement)
    Wend
    Transformation_Literal = True
End Function

Function ValeurFormule (S As String) As String
    Dim F As String

    Dim I As Integer
    Dim J As Integer

    Dim X As Integer
    Dim X1 As Integer
    Dim X2 As Integer
    Dim NumOperation As Integer
    Dim Y As Integer
    Dim SFDebut As Integer
    Dim SFFin As Integer

    Dim Valeur1 As Variant
    Dim Valeur2 As Variant
'                                                                                                                                                                                                                                                                                                   '
'                                                                                                                                                                                                                                                                                                    '
'Cette procΘdure calcule la valeur de la formule contenue dans S                                                                                                                                                                                                                                      '
'                                                                                                                                                                                                                                                                                                      '
'                                                                                                                                                                                                                                                                                                       '
    F = Trim(S)
    Call MoinsParMoins(F)

    '                                                                                                                                                                                                                                                                                       '
    'Boucle de calcul avec l'opΘrande ^                                                                                                                                                                                                                                                    '
    '                                                                                                                                                                                                                                                                                         '
    X = InStr(F, Operation(1))

    While X
        'On recherche les opΘrandes                                                                                                                          '
        Call Operande_Anterieur(X, F, Valeur1, SFDebut)
        Call Operande_Posterieur(X, F, Valeur2, SFFin)
        If Valeur1 = MessageErreur Or Valeur2 = MessageErreur Then ValeurFormule = MessageErreur: Exit Function

        'On effectue l'opΘration                                                                                                                            '
        Valeur1 = Valeur1 ^ Valeur2
        Valeur1 = Trim(Format(Valeur1))

        'On remet α jour la formule                                                                                                                                                                         '
        F = Left$(F, SFDebut) + Valeur1 + Right$(F, Len(F) - SFFin + 1)

        'On reboucle                                                                                                                                        '
        X = InStr(F, Operation(1))
    Wend
    Call MoinsParMoins(F)


    '                                                                                                                                                                                                                                                                                       '
    'Boucle de calcul avec les opΘrandes *  /                                                                                                                                                                                                                                                   '
    '                                                                                                                                                                                                                                                                                         '
    X1 = InStr(F, Operation(2))
    X2 = InStr(F, Operation(3))
    While (X1 Or X2)
        If ((X1 > X2 And X2 <> 0) Or X1 = 0) Then X = X2:  Else X = X1

        'On recherche les opΘrandes                                                                                                                          '
        Call Operande_Anterieur(X, F, Valeur1, SFDebut)
        Call Operande_Posterieur(X, F, Valeur2, SFFin)
        If Valeur1 = MessageErreur Or Valeur2 = MessageErreur Then ValeurFormule = MessageErreur: Exit Function

        'On effectue l'opΘration                                                                                                                            '
        If X = X1 Then
            Valeur1 = Valeur1 * Valeur2
        Else
            If Valeur2 Then
                Valeur1 = Valeur1 / Valeur2
            Else
                ValeurFormule = MessageErreur
                Exit Function
            End If
        End If
        Valeur1 = Trim(Format(Valeur1))

        'On remet α jour la formule                                                                                                                                                                         '
        F = Left$(F, SFDebut) + Valeur1 + Right$(F, Len(F) - SFFin + 1)

        'On reboucle                                                                                                                                        '
        X1 = InStr(F, Operation(2))
        X2 = InStr(F, Operation(3))
    Wend
    Call MoinsParMoins(F)

    '                                                                                                                                                                                                                                                                                       '
    'Boucle de calcul avec l'opΘrande MOD                                                                                                                                                                                                                                                    '
    '                                                                                                                                                                                                                                                                                         '
    X = InStr(F, Operation(4))

    While X
        'On recherche les opΘrandes                                                                                                                          '
        Call Operande_Anterieur(X, F, Valeur1, SFDebut)
        Call Operande_Posterieur(X, F, Valeur2, SFFin)
        If Valeur1 = MessageErreur Or Valeur2 = MessageErreur Then ValeurFormule = MessageErreur: Exit Function

        'On effectue l'opΘration                                                                                                                            '
        Valeur1 = Valeur1 Mod Valeur2
        Valeur1 = Trim(Format(Valeur1))

        'On remet α jour la formule                                                                                                                                                                         '
        F = Left$(F, SFDebut) + Valeur1 + Right$(F, Len(F) - SFFin + 1)

        'On reboucle                                                                                                                                        '
        X = InStr(F, Operation(4))
    Wend
    Call MoinsParMoins(F)

    '                                                                                                                                                                                                                                                                                       '
    'Boucle de calcul avec les opΘrandes +  -                                                                                                                                                                                                                                                   '
    '                                                                                                                                                                                                                                                                                         '
    Do
        X = 0
        'On vΘrifie si ce n'est pas un signe qu'on a trouvΘ                                                                                                     '
        Do
            X1 = InStr(X + 1, F, Operation(5))
            X2 = InStr(X + 1, F, Operation(6))
            If X2 = 1 Then X2 = InStr(2, F, Operation(6))
            If ((X1 > X2 And X2 <> 0) Or X1 = 0) Then X = X2:  Else X = X1
        Loop Until (Not Signe(X, F)) Or (X = 0)

        If X = 0 Then Exit Do
        'On recherche les opΘrandes                                                                                                                          '
        Call Operande_Anterieur(X, F, Valeur1, SFDebut)
        Call Operande_Posterieur(X, F, Valeur2, SFFin)

        If Valeur1 = MessageErreur Or Valeur2 = MessageErreur Then ValeurFormule = MessageErreur: Exit Function

        'On effectue l'opΘration                                                                                                                            '
        If X = X1 Then Valeur1 = Valeur1 + Valeur2 Else Valeur1 = Valeur1 - Valeur2
        Valeur1 = Trim(Format(Valeur1))

        'On remet α jour la formule                                                                                                                                                                         '
        F = Left$(F, SFDebut) + Valeur1 + Right$(F, Len(F) - SFFin + 1)
    Loop
    Call MoinsParMoins(F)

    '                                                                                                                                                               '
    'Calcule de la formule en ligne de la gauche vers la droite pour les opΘration de comparaison                                                                                                                                 '
    '                                                                                                                                                                 '
    F = Trim(F)
    Do
        X = Len(F) + 1

        For I = 7 To 15
            X1 = InStr(F, Operation(I))
            If X1 <> 0 And X1 < X Then NumOperation = I: X = X1
        Next I

        If X = Len(F) + 1 Then Exit Do

        'Recherche des l'opΘrandes Gauche                                                                                                                                     '
        Call Operande_Anterieur_Comparaison(X, F, Valeur1, SFDebut)
        Call Operande_Posterieur_Comparaison(X + Len(Operation(NumOperation)) - 1, F, Valeur2, SFFin)

        Call ValeurOperande(Valeur1)
        Call ValeurOperande(Valeur2)

        If Valeur1 = MessageErreur Or Valeur2 = MessageErreur Then ValeurFormule = MessageErreur: Exit Function
        If (VarType(Valeur1) <> 8 Or VarType(Valeur2) <> 8) And (VarType(Valeur1) = 8 Or VarType(Valeur2) = 8) Then ValeurFormule = MessageErreur: Exit Function

        'On effectue l'opΘration                                                                                                                            '
        Select Case NumOperation

        Case 7: Valeur1 = (Valeur1 >= Valeur2)
        Case 8: Valeur1 = (Valeur1 <= Valeur2)
        Case 9: Valeur1 = (Valeur1 >= Valeur2)
        Case 10: Valeur1 = (Valeur1 <= Valeur2)
        Case 11: Valeur1 = (Valeur1 <> Valeur2)
        Case 12: Valeur1 = (Valeur1 > Valeur2)
        Case 13: Valeur1 = (Valeur1 < Valeur2)
        Case 14: Valeur1 = (Valeur1 = Valeur2)

        Case 15
            If VarType(Valeur1) <> 8 Then ValeurFormule = MessageErreur: Exit Function
            If InStr(Valeur1, Valeur2) Then Valeur1 = True:  Else Valeur1 = False

        Case Else

        End Select

        Valeur1 = Trim(Format(Valeur1))

        'On remet α jour la formule                                                                                                                                                                         '
        F = Left$(F, SFDebut) + Valeur1 + Right$(F, Len(F) - SFFin + 1)
        Call MoinsParMoins(F)
    Loop


    '                                                                                                                                                                                                                                                                                       '
    'Boucle de calcul avec l'opΘrande NOT                                                                                                                                                                                                                                                    '
    '                                                                                                                                                                                                                                                                                         '
    X = InStr(F, Operation(16))
    While X
        'On recherche les opΘrandes                                                                                                                          '
        X = X + 2
        Call Operande_Posterieur(X, F, Valeur2, SFFin)
        If Valeur2 = MessageErreur Then ValeurFormule = MessageErreur: Exit Function

        'On effectue l'opΘration                                                                                                                            '
        Valeur1 = Not (Val(Valeur2))
        Valeur1 = Trim(Format(Valeur1))

        'On remet α jour la formule                                                                                                                                                                         '
        F = Left$(F, X - 3) + Valeur1 + Right$(F, Len(F) - SFFin + 1)
        Call MoinsParMoins(F)

        'On reboucle                                                                                                                                        '
        X = InStr(F, Operation(16))
    Wend

    '                                                                                                                                                                                                                                                                                       '
    'Boucle de calcul avec l'opΘrande AND                                                                                                                                                                                                                                                    '
    '                                                                                                                                                                                                                                                                                         '
    X = InStr(F, Operation(17))

    While X
        'On recherche les opΘrandes                                                                                                                          '
        Call Operande_Anterieur(X, F, Valeur1, SFDebut)
        X = X + 2
        Call Operande_Posterieur(X, F, Valeur2, SFFin)
        If Valeur1 = MessageErreur Or Valeur2 = MessageErreur Then ValeurFormule = MessageErreur: Exit Function

        'On effectue l'opΘration                                                                                                                            '
        Valeur1 = Valeur1 And Valeur2
        Valeur1 = Trim(Format(Valeur1))

        'On remet α jour la formule                                                                                                                                                                         '
        F = Left$(F, SFDebut) + Valeur1 + Right$(F, Len(F) - SFFin + 1)
        Call MoinsParMoins(F)

        'On reboucle                                                                                                                                        '
        X = InStr(F, Operation(17))
    Wend


    '                                                                                                                                                                                                                                                                                       '
    'Boucle de calcul avec l'opΘrande OR                                                                                                                                                                                                                                                    '
    '                                                                                                                                                                                                                                                                                         '
    X = InStr(F, Operation(18))

    While X
        'On recherche les opΘrandes                                                                                                                          '
        Call Operande_Anterieur(X, F, Valeur1, SFDebut)
        X = X + 1
        Call Operande_Posterieur(X, F, Valeur2, SFFin)
        If Valeur1 = MessageErreur Or Valeur2 = MessageErreur Then ValeurFormule = MessageErreur: Exit Function

        'On effectue l'opΘration                                                                                                                            '
        Valeur1 = Valeur1 Or Valeur2
        Valeur1 = Trim(Format(Valeur1))

        'On remet α jour la formule                                                                                                                                                                         '
        F = Left$(F, SFDebut) + Valeur1 + Right$(F, Len(F) - SFFin + 1)
        Call MoinsParMoins(F)

        'On reboucle                                                                                                                                        '
        X = InStr(F, Operation(18))
    Wend

    '                                                                                                                                                                                                                                                                                       '
    'Boucle de calcul avec l'opΘrande &                                                                                                                                                                                                                                                    '
    '                                                                                                                                                                                                                                                                                         '
    X = InStr(F, Operation(19))

    While X
        'On recherche les opΘrandes                                                                                                                          '
        Call Operande_Anterieur_Comparaison(X, F, Valeur1, SFDebut)
        Call Operande_Posterieur_Comparaison(X, F, Valeur2, SFFin)

        Call ValeurOperande(Valeur1)
        Call ValeurOperande(Valeur2)

        If VarType(Valeur1) <> 8 And VarType(Valeur2) <> 8 Then Valeur1 = MessageErreur
        If Valeur1 = MessageErreur Or Valeur2 = MessageErreur Then ValeurFormule = MessageErreur: Exit Function

        'On effectue l'opΘration                                                                                                                            '
        Valeur1 = Valeur1 & Valeur2
        ReDim Preserve Literal(UBound(Literal) + 1)
        Literal(UBound(Literal)) = Valeur1
        Valeur1 = "@" + Format(UBound(Literal))
        Valeur1 = Trim(Format(Valeur1))

        'On remet α jour la formule                                                                                                                                                                         '
        F = Left$(F, SFDebut) + Valeur1 + Right$(F, Len(F) - SFFin + 1)
        Call MoinsParMoins(F)

        'On reboucle                                                                                                                                        '
        X = InStr(F, Operation(19))
    Wend


    '                                                                                                                                                                                                                               '
    'On n'a plus d'opΘration, on renvoie le rΘsultat                                                                                                                                                                                                         '
    '                                                                                                                                                                                                                                 '
    Valeur1 = F
    Call ValeurOperande(Valeur1)

    ValeurFormule = Format(Valeur1)
End Function

Sub ValeurOperande (V As Variant)
    Dim Signe As Integer
    Dim L As Long
    Dim I As Integer
'                                                                                                                                                                                                                                                                       '
'                                                                                                                                                                                                                                                                        '
'Cette formule Θvalue et controle le montant de l'opΘrande                                                                                                                                                                                                                            '
'                                                                                                                                                                                                                                                                          '
'                                                                                                                                                                                                                                                                           '
    V = Trim(V)

    'On effectue les tests                                                                                                                                                                                          '
    If Len(V) = 0 Then V = MessageErreur: Exit Sub

    'Est ce un numΘrique?                                                                                                           '
    If IsNumeric(V) Then V = Val(V):  Exit Sub

    'Est ce un literral?                                                                                                                                '
    If Left$(V, 1) = "@" Then
        If Len(V) > 1 Then
            L = Val(Right$(V, Len(V) - 1))
            If L > UBound(Literal) Or L <= 0 Then V = MessageErreur: Exit Sub
            V = Literal(L)
            'Est ce une date                                                                                                            '
            If IsDate(V) Then L = DateValue(V): V = L
            Exit Sub
        Else
            V = MessageErreur
            Exit Sub
        End If
    End If

    'Est ce une rΘfΘrence de datas?                                                                                                                     '
    'Ces lignes sont α adapter au cas de votre programme                                                                                                 '
    If Left$(V, 1) = "-" Then Signe = -1: V = Right$(V, Len(V) - 1): Else Signe = 1

    If Len(V) = 0 Then V = MessageErreur: Exit Sub

    For I = 1 To NbIntitule
        If V = Intitule(I) Then
            'C'est une rΘfΘrence de ligne on contr⌠le sa validitΘ                                                                                                                                                                                  '
            V = UCase$(Form1.Datas(I - 1))
            If IsNumeric(V) Then V = Signe * Val(V): Exit Sub
            If Signe = -1 Then V = MessageErreur: Exit Sub
            If IsDate(V) Then L = DateValue(V): V = L
            Exit Sub
        End If
    Next I
    V = MessageErreur
End Sub