Access2003+état requete analyse croisée avec nombre champs variables

Access2003+état requete analyse croisée avec nombre champs variables - VB/VBA/VBS - Programmation

Marsh Posté le 24-08-2010 à 13:11:18    

Bonjour au forum,
Mon problème est le suivant : je souhaite sur une appli Access 2003 générer 1 état sur une requête analyse croisée dont le nombre de champs varie en fonction du résultat retourné par la requête (5 à 31). J’ai trouvé un code qui répond parfaitement à une partie de mon besoin et qui illustre le 1er état (ci-dessous) ; le code est listé après la 2ème copie écran.
Je souhaite ajouté ajouter des niveaux de regroupement afin d’effectuer 1 sous-total pour chaque valeur »Objet » et cumul pour chaque valeur « Type_Erreur ». J’ai donc déplacé le code de la section Détail dans la partie Entête_Groupe1 (Objet) et copié le code du pied d’état dans la partie pied de groupe0. Le résultat est correct pour la partie entête de groupe1 puisque c’est identique à la partie détail mais dans les sous-totaux j’ai les valeurs du pied d’état. Y-a t-il une solution pour ajouter du code qui intègre un sous-total dans 1 pied de groupe ?
Merci de votre aide…
USAC49  
Code :
Option Compare Database
' ***** déclaration des variables ***** '
Const Nombre_colonnes = 31 ' Nombre maximum d'étiquettes sur l'état (par rapport à l'exemple) & _
    on peut en afficher plus et donc modifier cette variable
Dim dbBase As DAO.Database
Dim rstEnregistrement As DAO.Recordset
Dim NbColonnes As Integer
Dim Total_colonnes(1 To Nombre_colonnes) As Long
Dim Total_etat As Long
 
Private Sub Report_Open(Annuler As Integer)
     
    Dim rstRequete As DAO.QueryDef
     
    Set dbBase = CurrentDb
    Set rstRequete = dbBase.QueryDefs("R_Tempo_Unite" )
    Set rstEnregistrement = rstRequete.OpenRecordset()
    'Définit le nombre de colonnes de la requête
    NbColonnes = rstRequete.Fields.Count
 
End Sub
Private Sub Initvar()
 
    Dim entX As Integer
    Total_etat = 0
     
    For entX = 1 To NbColonnes
        Total_colonnes(entX) = 0
    Next entX
     
End Sub
 
Private Sub EntêteÉtat_Format(Annuler As Integer, FormatCount As Integer)
    rstEnregistrement.MoveFirst
    Initvar
End Sub
 
Private Sub ZoneEntêtePage_Format(Cancel As Integer, FormatCount As Integer)
    Dim entX As Integer
     
    ' Met les entêtes de colonnes
    ' dans des zones de texte dans la section Entête.
    'For entX = 1 To NbColonnes
    For entX = 2 To NbColonnes
        Me("Entete" + Format(entX)) = rstEnregistrement(entX - 1).Name
    Next entX
 
    ' Crée l'entête Totaux de la prochaine zone de liste disponible.
    Me("Entete" + Format(NbColonnes + 1)) = "Totaux"
 
    ' Cache les zones de texte inutilisées dans la section Entête.
    For entX = (NbColonnes + 2) To Nombre_colonnes
        Me("Entete" + Format(entX)).Visible = False
    Next entX
End Sub
 
 
 
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
    Dim entX As Integer
 
    If Not rstEnregistrement.EOF Then
        If Me.FormatCount = 1 Then
            For entX = 1 To NbColonnes
                Me("Detail" + Format(entX)) = Nz(rstEnregistrement(entX - 1), 0)
            Next entX
 
            For entX = NbColonnes + 2 To Nombre_colonnes
                Me("Detail" + Format(entX)).Visible = False
            Next entX
 
            rstEnregistrement.MoveNext
        End If
    End If
 
Private Sub Détail_Print(Cancel As Integer, PrintCount As Integer)
    Dim entX As Integer
    Dim Nblignes As Long
'
    If Me.PrintCount = 1 Then
        Nblignes = 0
 
        For entX = 4 To NbColonnes
            Nblignes = Nblignes + Me("Detail" & entX)
'
            Total_colonnes(entX) = Total_colonnes(entX) + Me("Detail" + Format(entX))
        Next entX
'
        Me("Detail" + Format(NbColonnes + 1)) = Nblignes
        Total_etat = Total_etat + Nblignes
    End If
''utiliser Détail_Print, PAS Détail_Format qui est appelé PLUSIEURS fois
     If ([NoLigne] Mod 2) = 0 Then
          Section(0).BackColor = vbWhite
     Else
          Section(0).BackColor = 13434879
‘          'jaune pâle : joli et discret
   End If
     
End Sub
 
Private Sub Détail_Retreat()
'  rstEnregistrement.MovePrevious
 
End Sub

Reply

Marsh Posté le 24-08-2010 à 13:11:18   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed