Discussion :

[Devipir]

Bonjour,
Je cherche à créer des fonctions en VBA qui fonctionnent de la même façon que les fonctions intégrées aux requêtes Access comme Moyenne, Min, Ecart-type...

Par exemple une fonction qui renvoie la médiane d'une variable age des élève alias 'AgeElève' des classes d'un collège à partir d'une table 'T_Eleves' qui contient les champs 'NumeroDeClasse', 'NomElève' et 'AgeElève'.

Je parviens à obtenir un résultat en analysant des recordsets successifs créer à partir d'une instruction SQL rigide, mais j'aimerai récupérer de façon dynamique (en variable) le nom de la table et le nom du champ pour pouvoir réutiliser cette fonction avec d'autres tables et d'autres variables.

Merci pour toute aide !

[argyronet]

Bonjour,

Quelque soit la fonction à mettre en oeuvre, le principe est le même.
Tu passes en paramètre le nom de la table, le nom du ou des champs.

Par exemple:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Public Function UneFonctionAnalyse(ByVal TableName As String, ByVal FieldToCalculate As String, _
 ByVal FieldCondition As String, ByVal TheCondition As Integer) As Double
Dim oRS As DAO.Recordset
Dim oDB As Database
Dim SQL As String
Dim dblResult As Double

  SQL = "SELECT Champ1, Champ2 FROM " & TableName & " WHERE " & FieldCondition & " = " & _
TheCondition & ";"
  Set oDB = CurrentDb
  Set oRS = oDB.OpenRecordset(SQL, 2)
    If Not oRS.EOF Then
      dblResult = UneFonctionMathématique(oRS.Fields(FieldToCalculate).Value)
    End If
    oRS.Close
  Set oDB = Nothing
  Set oRS = Nothing
  UneFonctionAnalyse = dblResult
End Function

Private Function UneFonctionMathématique(ByVal ValueToCalculate As Double) As Double
'[...]

End Function

Argy

[Devipir]

Merci pour cette réponse mais justement je ne souhaite pas à avoir à donner manuellement les paramètres 'NomTable' et 'NomChamp.'
Je souhaite que ma fonction fonctionne de la même manière que la fonction intégrée Moyenne par exemple.

Il faut que ma fonction retrouve "toute seule" la table et le champ à partir de la requête qui l'utilise.
De cette façon la fonction pourrait être réutilisée sur n'importe quelle table sans avoir à chaque fois à donner manuellement le nom de la table ou le nom du champ.

Merci.

[argyronet]

Bien tu n'es pas obligé de préciser la table (c'est ici un simple exemple), tu ne te contente que tu champ qui est en fait un paramètre numérique...
Et désolé de te décevoir, mais la fonction Moyenne() nécessite un argument dans lequel tu mets justement un nom de champ...

Donc, à toi de peaufiner la fonction de manière à ce qu'elle devienne générique, ce n'est pas bien compliqué.

Argy

[Devipir]

Merci encore mais je n'ai pas réussi à rendre ma fonction générique. Je ne parviens pas à récupérer le nom de table et de champ concerné.

Pour la fonction Moyenne (sans parenthèse justement!) je faisais référence à l'opération qu'il est possible d'effectuer dans la ligne Opération lors de la construction de requêtes sous Access 2002 (entre la ligne Table: et la ligne Tri.

En fait ma question pourrait revenir à : Comment ajouter des opérations (une opération médiane par exemple) aux requêtes Access ?

Merci beaucoup !

[philben]

Bonjour,

la fonction de regroupement Médiane n'existe pas. Il faut donc la créer...

Par chance, des bonnes âmes comme Agyronet et moi ont maché le boulot !

Le code VBA à inclure dans un module standard :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
 
 
Public Function MedianeDom(ByVal sExpression As String, ByVal sTable As String, _
   Optional ByVal sCritere As String = vbNullString, Optional ByVal bNullAsZero As Boolean = False) As Variant
   On Error GoTo MDErr
   Dim oDb As DAO.Database
   Dim oRs As DAO.Recordset
   Dim sSql As String, sMsgErr As String
 
   If Len(sExpression) = 0 Or InStr(1, sExpression, "*", vbBinaryCompare) > 0 Then
      sMsgErr = "<Expression> ne peut être vide ou égal à '*'."
   ElseIf InStr(1, sExpression, ",", vbBinaryCompare) > 0 Then
      sMsgErr = "<Expression> ne doit pas retourner plus d'un champ."
   ElseIf InStr(1, sExpression, " AS ", vbTextCompare) > 0 Then
      sMsgErr = "Le champ de <Expression> ne doit pas être aliasé."
   ElseIf Len(sTable) = 0 Then
      sMsgErr = "<Table> ne peut être vide."
   Else
      sSql = "SELECT " & sExpression & " FROM " & sTable
      If bNullAsZero = False Then
         If Len(sCritere) > 0 Then
            sCritere = sCritere & " AND NOT ISNULL(" & sExpression & ")"
         Else
            sCritere = "Not IsNull(" & sExpression & ")"
         End If
      End If
      If Len(sCritere) > 0 Then
         sSql = sSql & " WHERE " & sCritere
      End If
      sSql = sSql & " ORDER BY " & sExpression & ";"
      Set oDb = CurrentDb
      Set oRs = oDb.OpenRecordset(sSql, dbOpenSnapshot)
      If oRs.EOF = False Then
         Select Case oRs.Fields(0).Type
            Case dbByte, dbInteger, dbLong, dbFloat, dbSingle, dbDouble
               MedianeDom = CalcMedianeDom(oRs)
            Case Else
               sMsgErr = "<Expression> doit retourner un nombre."
         End Select
      End If
   End If
   If Len(sMsgErr) > 0 Then
      MsgBox sMsgErr, vbExclamation, "MedianeDom"
   End If
fin:
   Set oRs = Nothing
   Set oDb = Nothing
   Exit Function
MDErr:
   MsgBox "Erreur n°" & Err.Number & vbCrLf & "Description :" & Err.Description, vbExclamation, "MedianeDom"
   Resume fin
End Function
 
Private Function CalcMedianeDom(oRs As DAO.Recordset) As Variant
   Dim lCountEnr As Long
   oRs.MoveLast
   oRs.MoveFirst
   lCountEnr = oRs.RecordCount
   If lCountEnr > 1 Then
      oRs.Move Int(lCountEnr / 2)
      CalcMedianeDom = Nz(oRs.Fields(0))
      If lCountEnr Mod 2 = 0 Then
         oRs.MovePrevious
         CalcMedianeDom = (CalcMedianeDom + Nz(oRs.Fields(0))) / 2
      End If
   Else
      CalcMedianeDom = Nz(oRs.Fields(0))
   End If
End Function

Appel :
MedianeDom("Le nom du champ ou une expression","Une table","Un critère de filtre",True ou False)

le dernier paramètre permet de définir si les valeurs nulles doivent
être considérées égales à zéro ou si elles sont exclues du calcul de la médiane.

Exemple d'utilisation : Voir pièce-jointe

Bon courage,

Philippe

P.S. : Fonction partiellement validées => A vérifier

[argyronet]

Bravo philben...
Là, ce n'est plus catégorifé comme mâché, il y a le plateau avec

J'espère que Devipir pourra satisfaire sa requête...

Argy

[Devipir]

Merci pour ce bon code, mais cela ne résoud toujours pas mon souhait de ne PAS DONNER le nom de la table à la fonction, j'aimerai qu'elle se contente du nom de champ (et seulement du nom de champ) pour renvoyer la médiane.

Les fonctions des Opérations standards (Moyenne, Ecart-type...) dans la liste déroulante de la ligne Opération ne demandent pas de nom de table, je souhaite que ma fonction médiane en fasse tout autant.

Mais peut-être que ce n'est pas possible...

[philben]

Bonjour,

La médiane n'est pas une fonction d'agrégat standard et, à première vue, je ne vois pas d'autres solutions que de passer par une fonction spécifique qui nécessite le nom de la table pour réaliser le calcul.

Désolé si ma solution ne remplit pas tout tes critères...


Philippe

P.S. Je me suis aperçu que Tofalu propose un calcul de médiane dans la FAQ, mais il utilise aussi le nom de la table...
http://access.developpez.com/sources/?page=Conv#Mediane