Voila un programme qui permet de calculer une expression numérique provenant d'un textbox par exemple, ou de toute chaine de caractère de type string. Donc il gere ,en plus des opérations courantes (+,-,/,*,^), les fonctions cos, sin, tan, ln, exp, il gere aussi des calcules avec paranthèses, et il gére aussi 2 variable (x et z)....
Et puis vous avez qu'a aller voir le code.
C'est les fonctions qui m'ont servis pour mon graph 3d, donc certains le reconnaitront peut-être, j'y ai rajouté des commentaires et changé 2-3 trucs.
Source / Exemple :
'à placer dans un module
Public Function Calcul(Expr As Variant, Optional VarX As Variant, Optional VarZ As Variant) As Variant
Dim ParD, ParG, ExprPar
Expr = Replace(Expr, ".", ",")
Expr = Replace(Expr, "-c", "-1*c")
Expr = Replace(Expr, "-s", "-1*s")
Expr = Replace(Expr, "-t", "-1*t")
Expr = Replace(Expr, "-e", "-1*e")
Expr = Replace(Expr, "-x", "-1*x")
Expr = Replace(Expr, "-z", "-1*z")
Expr = Replace(Expr, "-l", "-1*l")
Expr = Replace(Expr, "-(", "-1*(")
For n = 0 To 9 Step 1
Expr = Replace(Expr, n & "c", n & "*c")
Expr = Replace(Expr, n & "s", n & "*s")
Expr = Replace(Expr, n & "t", n & "*t")
Expr = Replace(Expr, n & "e", n & "*e")
Expr = Replace(Expr, n & "x", n & "*x")
Expr = Replace(Expr, n & "z", n & "*z")
Expr = Replace(Expr, n & "l", n & "*l")
Expr = Replace(Expr, n & "(", n & "*(")
Next
Expr = Replace(Expr, "x", CStr(VarX)) 'cherche x dans l'expression et le ramplace par sa valeur
Expr = Replace(Expr, "z", CStr(VarZ)) 'idem pour z
Expr = Replace(Expr, " ", "")
Expr = Replace(Expr, "e", CCur(Exp(1)))
Expr = Replace(Expr, "ln", "l")
Expr = Replace(Expr, "cos", "c")
Expr = Replace(Expr, "sin", "s")
Expr = Replace(Expr, "tan", "t")
n = 0
Do
On Error GoTo Impossible 'permet de ne pas fermer le programme en cas d'erreur ex : pour 5/0
DoEvents
n = n + 1
If Mid(Expr, n, 1) = "(" Then ParG = n 'releve la dernier paranthèse ouverte
If Mid(Expr, n, 1) = ")" Then 'releve la 1er paranthèse fermée
ParD = n
ExprPar = Mid(Expr, ParG + 1, ParD - 1 - ParG) 'releve le morceau d'expression numérique entre les paranthèses
ExprPar = Analyse(ExprPar, VarX, VarZ) 'calcule l'expression entre les paranthèse
Expr = Left(Expr, ParG - 1) & ExprPar & Right(Expr, Len(Expr) - ParD) 'remplace l'expression entre les paranthèses par sa valeur dans l'expression du départ
n = 0
ParG = 0
ParD = 0
End If
If n >= Len(Expr) Then GoTo FinParanthese 'permet de sortir de la boucle quand il n'y a plus de paranthèse
Loop
FinParanthese:
Expr = Analyse(Expr, VarX, VarZ)
Calcul = Expr
GoTo Sortie
Impossible:
Calcul = "Erreur, opération interdite"
Sortie:
End Function
Public Function Analyse(Expr As Variant, Optional VarX As Variant, Optional VarZ As Variant) As Variant
'déclare les différentes variable utilisé dans la fonction
Dim ExprAna, Dernier, Suivant, ChercheSuiv, nSuiv, VarD, VarG, NewExpr As Double
Dim IndicOpéra As String
Depart:
Expr = Replace(Expr, "E", "*10^")
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'cosinus'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dernier = 0
n = 0
Suivant = 0
Do
DoEvents
n = n + 1
ExprAna = Mid(Expr, n, 1)
If ExprAna = Mid(Expr, n, 1) = "E" Then GoTo Depart
If ExprAna = "c" Then 'permet de trouvé le cosinus
nSuiv = n + 1
Do
DoEvents
nSuiv = nSuiv + 1
ChercheSuiv = Mid(Expr, nSuiv, 1)
'cherche l'operateur suivant qui permetra de delimité ce qui fait partie du cosinus
If ChercheSuiv = "*" Or ChercheSuiv = "/" Or ChercheSuiv = "-" Or ChercheSuiv = "+" Then
Suivant = nSuiv
GoTo FinSuivCos
ElseIf nSuiv >= Len(Expr) Then
Suivant = Len(Expr) + 1
GoTo FinSuivCos
End If
Loop
FinSuivCos:
VarD = Mid(Expr, n + 1, Suivant - n - 1)
IndicOpéra = "cos"
On Error GoTo Impossible
NewExpr = CCur(Cos(CDbl(VarD))) 'calcule la valeur du cosinus
'remplace l 'expression ou il y a le cosinus par la valeur trouvé dans l'expression principale
Expr = Left(Expr, Dernier) & NewExpr & Right(Expr, Len(Expr) - (Suivant - 1))
n = 0
Dernier = 0
GoTo Trigo
'''''''''''''''''''''''''''''''''''''''
'sinus '''''''''''''''''''''''
ElseIf ExprAna = "s" Then
nSuiv = n + 1
Do
DoEvents
nSuiv = nSuiv + 1
ChercheSuiv = Mid(Expr, nSuiv, 1)
If ChercheSuiv = "*" Or ChercheSuiv = "/" Or ChercheSuiv = "-" Or ChercheSuiv = "+" Then
Suivant = nSuiv
GoTo FinSuivSin
ElseIf nSuiv >= Len(Expr) Then
Suivant = Len(Expr) + 1
GoTo FinSuivSin
End If
Loop
FinSuivSin:
VarD = Mid(Expr, n + 1, Suivant - n - 1)
IndicOpéra = "sin"
On Error GoTo Impossible
NewExpr = CCur(Sin(CDbl(VarD)))
Expr = Left(Expr, Dernier) & NewExpr & Right(Expr, Len(Expr) - (Suivant - 1))
n = 0
Dernier = 0
GoTo Trigo
'''''''''''''''''''''''''''''''''''''''
'tan '''''''''''''''''''''''
ElseIf ExprAna = "t" Then
nSuiv = n + 1
Do
DoEvents
nSuiv = nSuiv + 1
ChercheSuiv = Mid(Expr, nSuiv, 1)
If ChercheSuiv = "*" Or ChercheSuiv = "/" Or ChercheSuiv = "-" Or ChercheSuiv = "+" Then
Suivant = nSuiv
GoTo FinSuivTan
ElseIf nSuiv >= Len(Expr) Then
Suivant = Len(Expr) + 1
GoTo FinSuivTan
End If
Loop
FinSuivTan:
VarD = Mid(Expr, n + 1, Suivant - n - 1)
IndicOpéra = "tan"
On Error GoTo Impossible
NewExpr = CCur(Tan(CDbl(VarD)))
Expr = Left(Expr, Dernier) & NewExpr & Right(Expr, Len(Expr) - (Suivant - 1))
n = 0
Dernier = 0
GoTo Trigo
'''''''''''''''''''''''''''''''''''''''
'ln '''''''''''''''''''''''
ElseIf ExprAna = "l" Then
nSuiv = n + 1
Do
DoEvents
nSuiv = nSuiv + 1
ChercheSuiv = Mid(Expr, nSuiv, 1)
If ChercheSuiv = "*" Or ChercheSuiv = "/" Or ChercheSuiv = "-" Or ChercheSuiv = "+" Then
Suivant = nSuiv
GoTo FinSuivLn
ElseIf nSuiv >= Len(Expr) Then
Suivant = Len(Expr) + 1
GoTo FinSuivLn
End If
Loop
FinSuivLn:
VarD = Mid(Expr, n + 1, Suivant - n - 1)
IndicOpéra = "ln"
On Error GoTo Impossible
NewExpr = CCur(Log(CDbl(VarD)))
Expr = Left(Expr, Dernier) & NewExpr & Right(Expr, Len(Expr) - (Suivant - 1))
n = 0
Dernier = 0
GoTo Trigo
End If
If (ExprAna = "*" Or ExprAna = "/" Or ExprAna = "-" Or ExprAna = "+") And n - Dernier > 1 Then Dernier = n
If n >= Len(Expr) Or (n >= 2 And Len(Expr) = 3) Then GoTo FinTrigo
Trigo:
Loop
FinTrigo:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Exposant ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Suivant = 0 'variable indiquant l'opérateur suivant
Dernier = 0 'variable indiquant le dernier opérateut
n = 1 'on commence à un car cela permet de sauter le 1er caractère
'de la chaine car si celui-ci est"-" il ne serat pas pris en compte
'donc ferat partie d'un nombre pour donner un nombre négatif
Do
DoEvents
n = n + 1
ExprAna = Mid(Expr, n, 1) 'donne le caractère de l'expression au niveau de n
'exemple ;si n = 6 -> mid("25+69-9",n,1)= "-"
'n=4 -> mid("25+69-9,n,2)= "69"
If ExprAna = Mid(Expr, n, 1) = "E" Then GoTo Depart
If ExprAna = "^" Then 'cherche les "^" dans la chaine de caractère
nSuiv = n + 1
Do
DoEvents
nSuiv = nSuiv + 1
ChercheSuiv = Mid(Expr, nSuiv, 1)
'une fois trouvé cherche le suivant quelconque
If ChercheSuiv = "^" Or ChercheSuiv = "*" Or ChercheSuiv = "/" Or ChercheSuiv = "-" Or ChercheSuiv = "+" Then
Suivant = nSuiv
GoTo FinSuivExp
ElseIf nSuiv >= Len(Expr) Then
Suivant = Len(Expr) + 1
GoTo FinSuivExp
End If
Loop
FinSuivExp:
VarG = Mid(Expr, Dernier + 1, n - Dernier - 1) 'permet de recuperer le nombre
'entre le dernier operateur quelconque et "^".
VarD = Mid(Expr, n + 1, Suivant - n - 1) 'ici entre "^" et l'opérateur suivant
On Error GoTo Impossible
NewExpr = CCur(CDbl(VarG) ^ CDbl(VarD)) 'ici on fait le calule, mais il faut transformer
'les nombres en variable de type Currency
Expr = Left(Expr, Dernier) & NewExpr & Right(Expr, Len(Expr) - (Suivant - 1)) 'ici on redonne la nouvelle expression après ce premier calule
' | |bout expr.| |
' | |calulé | |
'morceau expression avant | |morceau d'expression aprés
'le "dernier" opérateur | |l'operateur "suivant"
' | |
n = 1
Dernier = 0
GoTo Exp
End If
'permette d'enregistré le position du dernier opérateur
If (ExprAna = "^" Or ExprAna = "*" Or ExprAna = "/" Or ExprAna = "-" Or ExprAna = "+") And n - Dernier > 1 Then Dernier = n
If n >= Len(Expr) Or (n >= 2 And Len(Expr) = 3) Then GoTo FinExp 'quitte la boucle lorsqu'il n'a plus d'exposant
Exp:
Loop
FinExp:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'multiplication'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dernier = 0
n = 1
Suivant = 0
Do
DoEvents
n = n + 1
ExprAna = Mid(Expr, n, 1)
If ExprAna = Mid(Expr, n, 1) = "E" Then GoTo Depart
If ExprAna = "*" Then
nSuiv = n + 1
Do
DoEvents
nSuiv = nSuiv + 1
ChercheSuiv = Mid(Expr, nSuiv, 1)
If ChercheSuiv = "*" Or ChercheSuiv = "/" Or ChercheSuiv = "-" Or ChercheSuiv = "+" Then
Suivant = nSuiv
GoTo FinSuivFois
ElseIf nSuiv >= Len(Expr) Then
Suivant = Len(Expr) + 1
GoTo FinSuivFois
End If
Loop
FinSuivFois:
VarG = Mid(Expr, Dernier + 1, n - Dernier - 1)
VarD = Mid(Expr, n + 1, Suivant - n - 1)
On Error GoTo Impossible
NewExpr = CCur(CDbl(VarG) * CDbl(VarD))
Expr = Left(Expr, Dernier) & NewExpr & Right(Expr, Len(Expr) - (Suivant - 1))
n = 1
Dernier = 0
GoTo Prio
'''''''''''''''''''''''''''''''''''''''
'division '''''''''''''''''''''''
ElseIf ExprAna = "/" Then
nSuiv = n + 1
Do
DoEvents
nSuiv = nSuiv + 1
ChercheSuiv = Mid(Expr, nSuiv, 1)
If ChercheSuiv = "*" Or ChercheSuiv = "/" Or ChercheSuiv = "-" Or ChercheSuiv = "+" Then
Suivant = nSuiv
GoTo FinSuivDiv
ElseIf nSuiv >= Len(Expr) Then
Suivant = Len(Expr) + 1
GoTo FinSuivDiv
End If
Loop
FinSuivDiv:
VarG = Mid(Expr, Dernier + 1, n - Dernier - 1)
VarD = Mid(Expr, n + 1, Suivant - n - 1)
IndicOpéra = "/"
On Error GoTo Impossible
NewExpr = CCur(CDbl(VarG) / CDbl(VarD))
Expr = Left(Expr, Dernier) & NewExpr & Right(Expr, Len(Expr) - (Suivant - 1))
n = 1
Dernier = 0
GoTo Prio
End If
If (ExprAna = "*" Or ExprAna = "/" Or ExprAna = "-" Or ExprAna = "+") And n - Dernier > 1 Then Dernier = n
If n >= Len(Expr) Or (n >= 2 And Len(Expr) = 3) Then GoTo FinPrio
Prio:
Loop
FinPrio:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Soustraction'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dernier = 0
n = 1
Suivant = 0
Do
DoEvents
n = n + 1
ExprAna = Mid(Expr, n, 1)
If ExprAna = Mid(Expr, n, 1) = "E" Then GoTo Depart
If ExprAna = "-" Then
nSuiv = n + 1
Do
DoEvents
nSuiv = nSuiv + 1
ChercheSuiv = Mid(Expr, nSuiv, 1)
If ChercheSuiv = "-" Or ChercheSuiv = "+" Then
Suivant = nSuiv
GoTo FinSuivMoins
ElseIf nSuiv >= Len(Expr) Then
Suivant = Len(Expr) + 1
GoTo FinSuivMoins
End If
Loop
FinSuivMoins:
VarG = Mid(Expr, Dernier + 1, n - Dernier - 1)
VarD = Mid(Expr, n + 1, Suivant - n - 1)
On Error GoTo Impossible
NewExpr = CCur(CDbl(VarG) - CDbl(VarD))
Expr = Left(Expr, Dernier) & NewExpr & Right(Expr, Len(Expr) - (Suivant - 1))
n = 1
Dernier = 0
GoTo Second
'''''''''''''''''''''''''''''''''''''''
'Addition '''''''''''''''''''''''
ElseIf ExprAna = "+" Then
nSuiv = n + 1
Do
DoEvents
nSuiv = nSuiv + 1
ChercheSuiv = Mid(Expr, nSuiv, 1)
If ChercheSuiv = "-" Or ChercheSuiv = "+" Then
Suivant = nSuiv
GoTo FinSuivPlus
ElseIf nSuiv >= Len(Expr) Then
Suivant = Len(Expr) + 1
GoTo FinSuivPlus
End If
Loop
FinSuivPlus:
VarG = Mid(Expr, Dernier + 1, n - Dernier - 1)
VarD = Mid(Expr, n + 1, Suivant - n - 1)
On Error GoTo Impossible
NewExpr = CCur(CDbl(VarG) + CDbl(VarD))
Expr = Left(Expr, Dernier) & NewExpr & Right(Expr, Len(Expr) - (Suivant - 1))
n = 1
Dernier = 0
GoTo Second
End If
If (ExprAna = "-" Or ExprAna = "+") And n - Dernier > 1 Then Dernier = n
If n >= Len(Expr) Or (n >= 2 And Len(Expr) = 3) Then GoTo FinSecond
Second:
Loop
FinSecond:
Analyse = Expr
GoTo Sortie
Impossible:
If IndicOpéra = "/" Then Analyse = "Opération interdite : " & VarG & "/" & VarD
If IndicOpéra = "ln" Then Analyse = "Opération interdite : " & "ln" & VarD
Sortie:
End Function
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.