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

Les meilleures sources Access

Les meilleures sources AccessConsultez toutes les sources

Nombre d'auteurs : 44, nombre de sources : 147, création le 19 mars 2013 

 
OuvrirSommaireFormulairesGraphiques

Versions : Access 2000 et supérieures

Pour changer un ou plusieurs éléments dans un graphique logé dans un formulaire, il vous faut repérer ce graphe pour le sélectionner. Une fois sélectionné vous pouvez agir dessus. Ici, je vous propose d'intervenir sur l'axe des Y afin de changer dynamiquement les valeurs Maxi et Min de l'échelle.

Vous pouvez tester en appliquant ce code après avoir, bien entendu, adapté en conséquence de vos besoins, cet exemple étant théorique.

 
Sélectionnez
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
Créé le 12 novembre 2005  par Argyronet

Page de l'auteur

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 :

 
Sélectionnez
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
 
Sélectionnez
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
 
Sélectionnez
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 :

 
Sélectionnez
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.

Créé le 5 mars 2005  par User

Téléchargez le zip

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 © 2013 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.