Option Compare Database 
Option Explicit 
 
Private Sub cmdChangeScale_Click() 
'**************************************************** 
' Événement Click d'un bouton appelant la procédure UpdateMinMaxScale 
'**************************************************** 
Dim sngMinScale As Single 
Dim sngMaxScale As Single 
 
  sngMaxScale = Me!txtMaxScale 
  sngMinScale = Me!txtMinScale 
  UpdateMinMaxScale sngMinScale, sngMaxScale, "Graphique1" 
End Sub 
Sub UpdateMinMaxScale(ByVal MinScale As Single, ByVal MaxScale As Single, ByVal ChartName As String) 
'**************************************************** 
' Procédure : UpdateMinMaxScale 
' Paramètres : 
'   - MinScale  : Valeur mini de l'échelle 
'   - MaxScale  : Valeur maxi de l'échelle 
'   - ChartName : Nom du graphique 
'**************************************************** 
Const SCALE_VALUES = 2 
Const CHART_OBJECT = 113 
 
Dim oCtl As Control 
Dim oFrm As Form 
 
  Set oFrm = Form 
  For Each oCtl In oFrm.Controls 
    'Recherche des objets de type Chart 
    If oCtl.ControlType = CHART_OBJECT Then 
      'Identification de nom selon ChartName 
      If oCtl.ControlName = ChartName Then 
        With oCtl.Axes(SCALE_VALUES) 
          .MinimumScale = MinScale 
          .MaximumScale = MaxScale 
        End With 
        Exit For 
      End If 
    End If 
  Next oCtl 
  Set oFrm = Nothing 
End Sub

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

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