Permet de calculer une équation du type :
2*(V4*4²+(2*2))/8
Source / Exemple :
Function Calcule(TheCalcul As String)
Dim NewCalcul As String, ThePos As Long, Parenthese As String, CParenthese As String, NegPos As Long, NextPar As Long
NewCalcul = Replace(TheCalcul, " ", "")
NewCalcul = Replace(NewCalcul, ",", ".")
NewCalcul = "0+" & NewCalcul & "+0"
NewCalcul = UCase(NewCalcul)
While InStrRev(1, NewCalcul, "(") <> Len(NewCalcul) 'Calcule les parenthèses
ThePos = Len(NewCalcul) - InStrRev(1, NewCalcul, "(")
NextPar = InStr(ThePos, NewCalcul, ")")
Parenthese = Mid(NewCalcul, ThePos, NextPar - ThePos + 1)
CParenthese = Calcule(Mid(Parenthese, 2, Len(Parenthese) - 2))
NewCalcul = Mid(NewCalcul, 1, ThePos - 1) & CParenthese & Mid(NewCalcul, ThePos + Len(Parenthese), Len(NewCalcul) - (ThePos + Len(Parenthese)) + 1)
Wend
NewCalcul = Replace(NewCalcul, ",", ".")
While InStr(1, NewCalcul, "²") <> 0 'Calcule les carrés
ThePos = InStr(1, NewCalcul, "²")
NewCalcul = Mid(NewCalcul, 1, Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul)) & Val(Mid(NewCalcul, 1 + Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul), ThePos - (Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul)) - 1)) ^ 2 & Mid(NewCalcul, ThePos + (GetSeparatorRev(ThePos + 1, NewCalcul) - ThePos))
Wend
NewCalcul = Replace(NewCalcul, ",", ".")
While InStr(1, NewCalcul, "V") <> 0 'Calcule les racines carrés
ThePos = InStr(1, NewCalcul, "V")
NewCalcul = Mid(NewCalcul, 1, Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul)) & Sqr(Val(Mid(NewCalcul, ThePos + 1, GetSeparatorRev(ThePos + 1, NewCalcul) - ThePos - 1))) & Mid(NewCalcul, ThePos + (GetSeparatorRev(ThePos + 1, NewCalcul) - ThePos))
Wend
NewCalcul = Replace(NewCalcul, ",", ".")
If InStr(1, NewCalcul, "*") < InStr(1, NewCalcul, "/") Then 'Calcule les multiplications et les divisions
While InStr(1, NewCalcul, "*") <> 0
ThePos = InStr(1, NewCalcul, "*")
NewCalcul = Mid(NewCalcul, 1, Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul)) & (Val(Mid(NewCalcul, 1 + Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul), ThePos - (Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul)) - 1)) * Val(Mid(NewCalcul, ThePos + 1, GetSeparatorSP(ThePos + 1, NewCalcul) - ThePos - 1))) & Mid(NewCalcul, ThePos + (GetSeparatorSP(ThePos + 1, NewCalcul) - ThePos))
Wend
NewCalcul = Replace(NewCalcul, ",", ".")
While InStr(1, NewCalcul, "/") <> 0
ThePos = InStr(1, NewCalcul, "/")
NewCalcul = Mid(NewCalcul, 1, Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul)) & (Val(Mid(NewCalcul, 1 + Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul), ThePos - (Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul)) - 1)) / Val(Mid(NewCalcul, ThePos + 1, GetSeparatorSP(ThePos + 1, NewCalcul) - ThePos - 1))) & Mid(NewCalcul, ThePos + (GetSeparatorSP(ThePos + 1, NewCalcul) - ThePos))
Wend
Else
While InStr(1, NewCalcul, "/") <> 0
ThePos = InStr(1, NewCalcul, "/")
NewCalcul = Mid(NewCalcul, 1, Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul)) & (Val(Mid(NewCalcul, 1 + Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul), ThePos - (Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul)) - 1)) / Val(Mid(NewCalcul, ThePos + 1, GetSeparatorSP(ThePos + 1, NewCalcul) - ThePos - 1))) & Mid(NewCalcul, ThePos + (GetSeparatorSP(ThePos + 1, NewCalcul) - ThePos))
Wend
NewCalcul = Replace(NewCalcul, ",", ".")
While InStr(1, NewCalcul, "*") <> 0
ThePos = InStr(1, NewCalcul, "*")
NewCalcul = Mid(NewCalcul, 1, Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul)) & (Val(Mid(NewCalcul, 1 + Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul), ThePos - (Len(NewCalcul) - GetSeparator(Len(NewCalcul) - ThePos + 1, NewCalcul)) - 1)) * Val(Mid(NewCalcul, ThePos + 1, GetSeparatorSP(ThePos + 1, NewCalcul) - ThePos - 1))) & Mid(NewCalcul, ThePos + (GetSeparatorSP(ThePos + 1, NewCalcul) - ThePos))
Wend
End If
NewCalcul = Replace(NewCalcul, ",", ".")
Calcule = Addition(NewCalcul) 'Additionne le tout
End Function
Function InStrRev(Start As Long, String1 As String, String2 As String)
InStrRev = Len(String1)
For i = 1 To Len(String1) - Start
If Mid(String1, Len(String1) - Start - i + 1, Len(String2)) = String2 Then InStrRev = Start + i - 1: Exit Function
Next i
End Function
Function GetSeparatorRev(Start As Long, TheString As String)
Dim VAdd As Long, VDiv As Long, VMul As Long, VRac As Long, VSou As Long
VAdd = InStr(Start, TheString, "+")
VDiv = InStr(Start, TheString, "/")
VMul = InStr(Start, TheString, "*")
VRac = InStr(Start, TheString, "V")
VSou = InStr(Start, TheString, "-")
If VAdd = 0 Then
VAdd = Len(TheString) + 1
End If
If VDiv = 0 Then
VDiv = Len(TheString) + 1
End If
If VMul = 0 Then
VMul = Len(TheString) + 1
End If
If VRac = 0 Then
VRac = Len(TheString) + 1
End If
If VSou = 0 Then
VSou = Len(TheString) + 1
End If
If VAdd < VDiv And VAdd < VMul And VAdd < VRac And VAdd < VSou Then
GetSeparatorRev = VAdd
ElseIf VDiv < VAdd And VDiv < VMul And VDiv < VRac And VDiv < VSou Then
GetSeparatorRev = VDiv
ElseIf VRac < VAdd And VRac < VMul And VRac < VDiv And VRac < VSou Then
GetSeparatorRev = VRac
ElseIf VSou < VAdd And VSou < VMul And VSou < VDiv And VSou < VRac Then
GetSeparatorRev = VSou
Else
GetSeparatorRev = VMul
End If
End Function
Function GetSeparatorSP(Start As Long, TheString As String)
Dim VAdd As Long, VDiv As Long, VMul As Long, VRac As Long, VSou As Long
VAdd = InStr(Start, TheString, "+")
VDiv = InStr(Start, TheString, "/")
VMul = InStr(Start, TheString, "*")
VRac = InStr(Start, TheString, "V")
VSou = InStr(Start, TheString, "-")
If VAdd = 0 Then
VAdd = Len(TheString) + 1
End If
If VDiv = 0 Then
VDiv = Len(TheString) + 1
End If
If VMul = 0 Then
VMul = Len(TheString) + 1
End If
If VRac = 0 Then
VRac = Len(TheString) + 1
End If
If VSou - Start = 0 Or VSou = 0 Then
VSou = Len(TheString) + 1
End If
If VAdd < VDiv And VAdd < VMul And VAdd < VRac And VAdd < VSou Then
GetSeparatorSP = VAdd
ElseIf VDiv < VAdd And VDiv < VMul And VDiv < VRac And VDiv < VSou Then
GetSeparatorSP = VDiv
ElseIf VRac < VAdd And VRac < VMul And VRac < VDiv And VRac < VSou Then
GetSeparatorSP = VRac
ElseIf VSou < VAdd And VSou < VMul And VSou < VDiv And VSou < VRac Then
GetSeparatorSP = VSou
Else
GetSeparatorSP = VMul
End If
End Function
Function GetSeparator(Start As Long, TheString As String)
Dim VAdd As Long, VDiv As Long, VMul As Long, VRac As Long, VSou As Long
VAdd = InStrRev(Start, TheString, "+")
VDiv = InStrRev(Start, TheString, "/")
VMul = InStrRev(Start, TheString, "*")
VRac = InStrRev(Start, TheString, "V")
VSou = InStrRev(Start, TheString, "-")
If VAdd = 0 Then
VAdd = Len(TheString) + 1
End If
If VDiv = 0 Then
VDiv = Len(TheString) + 1
End If
If VMul = 0 Then
VMul = Len(TheString) + 1
End If
If VRac = 0 Then
VRac = Len(TheString) + 1
End If
If VSou = 0 Then
VSou = Len(TheString) + 1
End If
If VAdd < VDiv And VAdd < VMul And VAdd < VRac And VAdd < VSou Then
GetSeparator = VAdd
ElseIf VDiv < VAdd And VDiv < VMul And VDiv < VRac And VDiv < VSou Then
GetSeparator = VDiv
ElseIf VRac < VAdd And VRac < VMul And VRac < VDiv And VRac < VSou Then
GetSeparator = VRac
ElseIf VSou < VAdd And VSou < VMul And VSou < VDiv And VSou < VRac Then
GetSeparator = VSou
Else
GetSeparator = VMul
End If
End Function
Public Function Replace(ByVal laChaine As String, ByVal old_car As String, ByVal new_car As String) As String
Dim ncar As Integer, lng As Integer, result As String, txt As String
lng = Len(old_car)
txt = laChaine
If lng <= 0 Then
Replace = txt
Exit Function
End If
On Error GoTo ErrChangeCaractre
If lng <= 0 Or Len(Trim(txt)) <= 0 Then
Replace = txt
Exit Function
End If
result = vbNullString
ncar = InStr(txt, old_car)
Do While ncar
If Len(result) > 0 Then
If lng > 1 Then
If ncar = 1 Then
result = result & new_car
Else
result = result & Left(txt, ncar - 1) & new_car
End If
Else
result = result & Left(txt, ncar - 1) & new_car
End If
Else
result = Left(txt, ncar - 1) & new_car
End If
If lng > 1 Then
txt = Right(txt, Len(txt) - ncar - (lng - 1))
Else
txt = Right(txt, Len(txt) - ncar)
End If
ncar = InStr(txt, old_car)
Loop
If Len(txt) > 0 Then result = result & txt
Replace = result
Exit Function
ErrChangeCaractre:
Replace = result
End Function
Function Addition(TheCalcule As String)
Dim NextC, i As Long
NextC = Val(Mid(TheCalcule, 1, GetSeparatorRev(1, TheCalcule)))
TheCalcule = Replace(TheCalcule, "+-", "-")
TheCalcule = Replace(TheCalcule, "--", "+")
TheCalcule = Replace(TheCalcule, "++", "+")
For i = 1 To Len(TheCalcule)
If Mid(TheCalcule, i, 1) = "+" Then
NextC = NextC + Val(Mid(TheCalcule, i + 1, Len(TheCalcule) - GetSeparatorRev(i, TheCalcule)))
ElseIf Mid(TheCalcule, i, 1) = "-" Then
NextC = NextC - Val(Mid(TheCalcule, i + 1, Len(TheCalcule) - GetSeparatorRev(i, TheCalcule)))
End If
Next i
Addition = NextC
End Function
Conclusion :
Exemple :
Calcule("2*(V16)") 'renvoie 8
V --> Racine Carré
² --> Carré
/ --> Diviser
+ --> Additioner
- --> Soustraire
( --> Parenthèse
Mettez vos commentaire (il contient surement quelque bug, merci de me prevenir)...