Bonsoir develalex,
J’ai retrouvé du code VBA que j’avais développé il y a environ un an pour m’entraîner. Ce code pourrait être rendu moins verbeux, mais j’ai déjà supprimé plein d’instructions servant à des choses qui ne nous concernent pas ici.
Pour récupérer ce code (ou tout autre !) :
Dans la barre de menus, cliquer sur l’onglet « Database Tools » (désolé pour les termes, je n’ai que la version 2013 et angloricaine d’ACCESS... 
) :
Cliquer sur l’icône « Visual Basic » : on entre dans l’univers VBA (bien sombre 
) :
Pour arriver à amorcer la pompe, on clique sur l’icône qui va bien (« Insert Module ») :
Fiat lux ! On a droit maintenant de créer des instructions :
Coller le code VBA (que je fournis un peu plus loin).
Avant d’exécuter le code, créer les tables COMPOSANT (équivalente de la table COMPOSITION de mon message précédent) et PILE (table temporaire, dans laquelle on empile les comptages) :
COMPOSANT
{EnsembleId varchar, EnsembleParent varchar, Quantite integer}
KEY {EnsembleId, EnsembleParent} ;
PILE
{PileId autonumber, Niveau integer, EnsembleId varchar, EnsembleParent varchar, Quantite integer}
KEY {Niveau EnsembleId, EnsembleParent} ;
Les fonctions et procédures présentes dans le code VBA :
Une fonction (AilesRivetsRecursonsAmorce()) permet d’amorcer la pompe ; elle passe la main à une procédure récursive (AilesRivetsRecursonsJoyeusement) qui compte les composants (exemple, les rivets) du composé (exemple, l’aile).
Code VBA :
Option Compare Database
Option Explicit
'-------------------------------------------------------------------------
' Amorce du comptage
'-------------------------------------------------------------------------
Function AilesRivetsRecursonsAmorce()
Dim MaBase As DAO.Database
Dim Amorce As Integer, LeComposé As String, LeComposant As String, TotalOut As Integer
Set MaBase = CurrentDb
Amorce = 1
LeComposé = "aile"
LeComposant = "rivet"
' Initialisation de la pile utilisée pour les récursions
MaBase.Execute "DELETE FROM PILE ;"
'C'est parti pour compter les rivets !
Call AilesRivetsRecursonsJoyeusement(Amorce, LeComposé, LeComposant, TotalOut)
AilesRivetsRecursonsAmorce = TotalOut
' Au résultat
MsgBox " Composé : " & LeComposé & Chr(13) & Chr(13) _
& "Nombre total d'éléments du type " & LeComposant & " : " & TotalOut
MaBase.Execute "DELETE FROM PILE ;"
Set MaBase = Nothing
End Function
'-------------------------------------------------------------------------
' Routine récursive
'-------------------------------------------------------------------------
Sub AilesRivetsRecursonsJoyeusement(ByRef Amorce As Integer, ByVal LeComposé As String, ByVal Composant As String, ByRef TotalOut As Integer)
Dim MaBase As DAO.Database, Sqlresult As DAO.Recordset
Dim Kount As Integer, Requete As String, theNiveau As Integer
Set MaBase = CurrentDb
Requete = "SELECT COUNT(*) AS Kount FROM PILE ;"
Set Sqlresult = MaBase.OpenRecordset(Requete, dbOpenDynaset)
Kount = Sqlresult.Fields("Kount")
If Kount = 0 Then
theNiveau = 1
Else
Requete = "SELECT DISTINCT MAX(Niveau) AS MaxNiveau FROM PILE ;"
Set Sqlresult = MaBase.OpenRecordset(Requete, dbOpenDynaset)
theNiveau = Sqlresult.Fields("MaxNiveau").Value + 1
End If
If Amorce = 1 Then
Requete = "INSERT INTO PILE (EnsembleId, EnsembleParent, Quantite, Niveau) VALUES ('" & LeComposé & "', 0, 0, 1) ;"
MaBase.Execute Requete
Requete = "INSERT INTO PILE (EnsembleId, Ensembleparent, Quantite, Niveau)" _
& " SELECT EnsembleId, Ensembleparent, Quantite, " & 2 _
& " FROM COMPOSANT" _
& " WHERE Ensembleparent = '" & LeComposé & "' ;"
MaBase.Execute Requete
'' Allez petit ! on récurse !
Call AilesRivetsRecursonsJoyeusement(0, LeComposé, Composant, TotalOut)
Else
Requete = "SELECT COUNT(*) AS Kount " _
& "FROM (SELECT x.EnsembleId " _
& "FROM COMPOSANT AS x INNER JOIN PILE AS y ON x.Ensembleparent = y.EnsembleId " _
& "WHERE Niveau = " & theNiveau - 1 & ") as truc ; "
Set Sqlresult = MaBase.OpenRecordset(Requete, dbOpenDynaset)
Kount = Sqlresult.Fields("Kount")
If Kount > 0 Then
Requete = "INSERT INTO PILE (EnsembleId, Quantite, Niveau, Ensembleparent) " _
& " SELECT x.EnsembleId, SUM(x.Quantite * y.Quantite), " & theNiveau & ", x.Ensembleparent " _
& " FROM COMPOSANT AS x INNER JOIN PILE AS y ON x.Ensembleparent = y.EnsembleId " _
& " WHERE Niveau = " & theNiveau - 1 _
& " GROUP BY x.EnsembleId, x.Ensembleparent, " & theNiveau & " ;"
Requete = "SELECT SUM(Quantite) AS TotalOut FROM PILE WHERE EnsembleId = '" & Composant & "' ;"
Pour tester et exécuter le code VBA directement :
Pour exécuter les instructions pas à pas, utiliser la touche de fonction F8 :
Pour exécuter à partir d’une macro, on commence par créer celle-ci (logique ^^) :
Barre de menu : onglet « CREATE », icône « Macro » :
Cézigue nous demande d’ajouter une action (je rappelle que j’utilise ACCESS 2013, mais en principe ça marche aussi pour ACCESS 2010) :
Dans sa liste déroulante on choisit « RunCode » (ExécuterCode) :
On fournit le nom de la fonction qui prendra la main :
On ferme la fenêtre et on donne un nom à la macro :
Elle est là !
On l’exécute en double cliquant sur son nom :
=>
J’espère qu’il n’y aura pas de problème avec ACCESS 2010...
Code VBA à implanter sous Access 2010
Répondre avec citation
Partager