IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)



Auteur : User
Version : 05/03/2005
Téléchargez le zip
Représenter des fonctions mathématiques
Versions : 97 et supérieures

Cette application exemple met en oeuvre :

  • Utilisation de graphiques type courbe
  • Utilisation de graphiques type histogramme
  • Evaluation d'expressions mathématiques à l'aide de Eval

Le principe est simple : l'utilisateur entre une fonction avec une variable u. Puis il saisit des bornes d'étude ainsi qu'un intervalle et le programme boucle sur chaque valeur comprise entre les deux bornes avec un pas égal à l'intervalle saisi. Les valeurs sont au fur et à mesure ajoutées à une table. Enfin, la table est affectée à un graphique via la propriété RowSource. De plus, il est possible de passer d'un graphique de type histogramme à une courbe en changeant la propriété Type de l'objet graphique.

Type=3 --> Histogramme
Type=4 --> Courbe Voici le code qui lance le traitement :

On Error GoTo err Dim i As Integer, j As Integer Dim correct As Boolean Dim Min As Single, Max As Single, inter As Single Dim F(4) As String correct = True If typeGraph <> Continu And typeGraph <> discret Then _ typeGraph = Continu 'teste la validité des saisies For i = 1 To 4 If Nz(Me.Controls("Fonction" & i), "") <> "" And _ (Nz(Me.Controls("Fonction" & i), "") <> _ DFirst("Expression", "FonctionTous")) Then correct = correct And _ Testfun(Me.Controls("Fonction" & i), 1.1) F(i - 1) = Me.Controls("Fonction" & i) Else j = j + 1 End If Next i 'Si aucune fonction n'est saisie If j = 4 Then 'avertir MsgBox ("Saisir au moins une fonction !") Else 'si correct = faux alors, avertir If Not correct Then MsgBox ("Fonctions mal définies !") Else 'Verifie la saisie des maximum et minimum et interval If TestMinMax(Nz(Me.Min, ""), Nz(Me.Max, ""), _ Nz(Me.Intervalle, "")) Then 'convertit les valeurs Min = Val(Replace(Me.Min, ",", ".")) Max = Val(Replace(Me.Max, ",", ".")) inter = Val(Replace(Me.Intervalle, ",", ".")) If typeGraph = discret Then Min = Int(Min) Max = Int(Max) inter = Int(inter) If inter = 0 Then inter = 1 End If 'Execute le traitement MajValeurs F(0), F(1), F(2), F(3), Min, Max, inter RefreshGraph F(0), F(1), F(2), F(3), Me Me!ListeValeurs.Requery Me!Graph.Type = typeGraph Else 'sinon Avertir MsgBox ("Définition des valeurs des x incorrecte !") End If End If End If Exit Sub err: MsgBox "Une erreur est survenue : " & _ vbCrLf & vbCrLf & err.Description, vbCritical, "Erreur" End Sub
Private Function TestMinMax(Min As String, _ Max As String, inter As String) As Boolean Dim T(3) As Single If Min <> "" And Max <> "" And inter <> "" Then 'convertit les valeur T(0) = Val(Replace(Min, ",", ".")) T(1) = Val(Replace(Max, ",", ".")) T(2) = Val(Replace(inter, ",", ".")) If T(0) < T(1) And T(1) - T(2) >= T(0) And T(2) <> 0 _ Then TestMinMax = True End If End Function
Public Sub MajValeurs(f1 As String, f2 As String, f3 As String, _ f4 As String, Min As Single, Max As Single, Interval As Single) On Error Resume Next Dim RecL As dao.Recordset Dim x As Double 'definit le sablier DoCmd.Hourglass True 'vide la table CurrentDb.Execute "Delete * from valeurs" Set RecL = CurrentDb.OpenRecordset("Valeurs", dbOpenDynaset) x = Min Do While x <= Max 'Ajouter une nouvelle ligne RecL.AddNew RecL!x = x 'Affecte les valeurs calculée aux champs If (f1 <> "") Then RecL!f1 = Evaluer(f1, x) If (f2 <> "") Then RecL!f2 = Evaluer(f2, x) If (f3 <> "") Then RecL!f3 = Evaluer(f3, x) If (f4 <> "") Then RecL!f4 = Evaluer(f4, x) 'mettre à jour RecL.Update x = x + Interval 'arrondi à zero pour les valeurs proche de 0 If (Abs(x - 0) < 0.0001) Then x = 0 Loop 'enleve le sablier DoCmd.Hourglass False End Sub Public Sub RefreshGraph(f1 As String, f2 As String, _ f3 As String, f4 As String, Formulaire As Form) Dim SQL1 As String SQL1 = "SELECT [x] " If (f1 <> "") Then SQL1 = SQL1 & ",[f1] " If (f2 <> "") Then SQL1 = SQL1 & ",[f2] " If (f3 <> "") Then SQL1 = SQL1 & ",[f3] " If (f4 <> "") Then SQL1 = SQL1 & ",[f4] " SQL1 = SQL1 & " FROM [Valeurs] ;" Formulaire!Graph.RowSource = SQL1 Formulaire!Graph.Requery End Sub Public Function Evaluer(f As String, Valeur As Double) As Double Dim fnc As String fnc = ReplaceT(f, "u", "(u)") Evaluer = Eval(ReplaceT(fnc, "u", Str(Valeur))) End Function
Pour tester qu'une fonction est bien saisie, il suffit de l'évaluer avec une valeur. C'est ce que fait cette fonction :

Public Function Testfun(f As String, Valeur As Double) As Boolean On Error GoTo err 'teste un calcul avec une valeur 'Si echec alors, la fonction est incorrecte Dim y As Double f = ReplaceT(f, "u", "(u)") y = Eval(ReplaceT(f, "u", Str(Valeur))) Testfun = True err: End Function
Notons que depuis la version Access 2000, il est possible de remplacer la fonction ReplaceT par la fonction VBA Replace

N'hésitez pas à télecharger le fichier zip pour visualiser le résultat.



Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2004-2005 Maxence Hubiche Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.