Compléments pour Microsoft Access

Description

		Cette fonction permet de créer une requête de regroupement basé sur une table dont la structure peut changer. L'intégralité des champs sera sommé dans la requête à l'exception du ou des champs identifiés comme regroupés.

Synthaxe

fCreateQueryGroupSum (strTable, strQuery, fldGroup)

La synthaxe de la fonction fCreateQueryGroupSum comprend les éléments suivants :

Eléments	Description
strTable	Expression de chaîne correspondant au nom de la table qui servira de source à la requête.
strQuery	Expression de chaîne correspondant au nom de la requête que l'on souhaite créer.
fldGroup	Tableau contenant le ou les noms de champs qui doivent être regroupé dans la requête.

Exemple

Imaginons que nous avons une table dont la structure change régulièrement et qui se nomme "tblStructureChangeante".

Cette table est constitué aujourd'hui de 5 champs dont 2 qui serviront à regrouper les données :

Code (champ regroupé)
LibelleCode (champ regroupé)
PrixCode
QuantiteCode
Total

Dans ce cas la fonction devra être lancée de la manière suivante :

fCreateQueryGroupSum "tblStructureChangeante", "qryNew", "Code", "LibelleCode"

Cette fonction aura pour effet de créer une requête nommée "qryNew" qui aura le SQL suivant :

SELECT Code, LibelleCode, Sum(tblStructureChangeante.PrixCode) AS PrixCode, Sum(tblStructureChangeante.QuantiteCode) AS QuantiteCode, Sum(tblStructureChangeante.Total) AS Total
FROM tblStructureChangeante
GROUP BY tblStructureChangeante.Code, tblStructureChangeante.LibelleCode;

Maintenant si demain les champs contenant les montants qui doivent être sommé change de nom ou s'il y en a des nouveaux, la requête se recréé correctement.

Code de la fonction

Public Function fCreateQueryGroupSum(strTable As String, _
strQuery As String, ParamArray fldGroup())

On Error GoTo ERR_fCreateQueryGroupSum

Dim Db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim intField As Integer
Dim strSelect As String
Dim strGroup As String
Dim strSQL As String
Dim isFldGroup As Boolean

Set Db = CurrentDb
Set tdf = Db.TableDefs(strTable)

For Each fld In tdf.Fields
        isFldGroup = False
        For intField = 0 To UBound(fldGroup)
                If fld.Name = fldGroup(intField) Then
                        isFldGroup = True
                        Exit For
                End If
        Next
        If isFldGroup = True Then
                If strGroup = "" Then
                        strGroup = "GROUP BY " & fldGroup(intField)
                Else
                        strGroup = strGroup & ", " & fldGroup(intField)
                End If
                If strSelect = "" Then
                        strSelect = "SELECT " & fld.Name
                Else
                        strSelect = strSelect & ", " & fld.Name
                End If
        Else
                If strSelect = "" Then
                        strSelect = "SELECT Sum(" & strTable & "." & fld.Name & ") AS " & fld.Name
                Else
                        strSelect = strSelect & ", Sum(" & strTable & "." & fld.Name & ") AS " & fld.Name
                End If
        End If
Next

strSQL = strSelect & " FROM " & strTable & " " & strGroup

Db.CreateQueryDef strQuery, strSQL
Set tdf = Nothing
Db.Close: Set Db = Nothing

Exit Function

ERR_fCreateQueryGroupSum:
If Err.Number = 3012 Then
        DoCmd.DeleteObject acQuery, strQuery
        Resume
Else
        MsgBox "Erreur n°" & Err.Number & vbCrLf & Err.Description
        Set tdf = Nothing: Set Db = Nothing
End If

End Function

Création requête regroupement (Requête)