Bonjour,
Dans un soucis de durée d'exécution, j'aimerais avoir des conseils pour optimiser le code VBA de la fonction récursive ci-dessous.

Je vais tenter de donner toutes les informations nécessaires :
(modèle des relations en pièce jointe)

Dans le bâtiment industriel il existe un certain nombre de tableaux de distribution électrique qui comportent des organes de coupures : disjoncteurs, fusibles, et autres interrupteurs.
Chaque tableau alimente un ou plusieurs tableaux, qui alimentent d'autres tableaux, et ainsi de suite, jusqu'aux machines ou aux servitudes (on appelle servitude, tout élément pouvant faire entrave au confort, au travail, ou à la sécurité du personnel).
Chaque organe de coupure est donc un père ou un fils d'un autre organe, jusqu'aux extrémités.
La distribution impose que 2 organes peuvent être mutuellement pères et fils (couplages) et qu'un organe peut avoir plusieurs pères.
D'où l'existence des tables de jointure qui répertorient toute relation existant entre deux organes (on considère une source comme un organe).

But : lorsqu'on coupe un ou des organes de coupure, savoir toutes les servitudes qui ne sont plus alimentées. L'idée de la fonction récursive et de partir de chaque servitude et de remonter père après père afin de trouver un chemin susceptible de l'alimenter un courant.

NOTE : Le code fonctionne correctement

Evénement sur le bouton "calcul"
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
Private Sub btn_Calcul_Click()
 
DoCmd.SetWarnings False
 
'réinitialise toutes les alims à la valeur 0
Dim strSql As String
strSql = "UPDATE Organes SET Organes.Alimentation = NULL"
DoCmd.RunSQL strSql
 
Dim qdf As DAO.QueryDef
Dim rcs As Recordset
 
'définit la valeur d'alim des organes directement liés les sources
Set qdf = CurrentDb.QueryDefs("QRY_SetAlimAmont")
qdf.Execute
'rafraichit la liste des ID des servitudes
Set qdf = CurrentDb.QueryDefs("QRY_DelNonPere")
qdf.Execute
Set qdf = CurrentDb.QueryDefs("QRY_NonPere")
qdf.Execute
Set qdf = Nothing
 
Dim val As Integer
Set rcs = CurrentDb.OpenRecordset("tbl_TempFilsLst")
 
'récupération des ID des servitudes et appel de la fonction récursive
'rcs.MoveFirst
While Not rcs.EOF
val = rcs.Fields(0).Value
Calcul (val)
rcs.MoveNext
Wend
 
Set rcs = Nothing
Set qdf = Nothing
 
DoCmd.SetWarnings True
 
End Sub
Module "Calcul_Alim"
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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
Option Compare Database
Option Explicit
 
'Fonction récursive de calcul des Alimentations des servitudes
Function Calcul(ByVal ident As Integer) As Boolean
 
Dim strNameTable As String
Dim IsNoErr As Boolean
Dim tbl As DAO.TableDef
Dim rst As DAO.Recordset
 
'crée une table temporaire pour afficher les pères de l'organe ident
strNameTable = "tbl_TempPereLst" & ident
IsNoErr = CreerTable(strNameTable)
 
'si la table a été créée, continuer la procédure, sinon terminer la procédure
If IsNoErr = False Then GoTo Err
 
'insère les pères dans la table nouvellement créée
Dim strSql2 As String
 
strSql2 = "INSERT INTO " & strNameTable & " (Pere, Etat, Alimentation)"
strSql2 = strSql2 + " SELECT tj_Peres.Pere AS Pere, Organes.Etat AS Etat, Organes.Alimentation AS Alimentation"
strSql2 = strSql2 + " FROM tj_Peres INNER JOIN Organes ON tj_Peres.Pere=Organes.ID"
strSql2 = strSql2 + " WHERE tj_Peres.Fils = " & ident & ";"
DoCmd.RunSQL strSql2
Set rst = CurrentDb.OpenRecordset(strNameTable)
 
Dim cpt As Integer
Dim ptr As Boolean 'définira la valeur de l'alimentation de l'ID de l'organe en cours
Dim val As Integer
 
'calcule l'alimentation de chaque père et affecte sa valeur au ptr
'calcul du ptr : l'organe est alimenté si au moins un de ses pères est alimenté et enclenché
Do While Not rst.EOF
    If (rst.Fields(1) = True And rst.Fields(2) = True) Then
        ptr = True 'ptr = true si l'état et l'alimentation du père = true
        Exit Do 'et on sort de la boucle
    ElseIf (rst.Fields(1) = True And rst.Fields(2) = False) Then 'si l'état  = true et l'alimentation = false
        val = rst.Fields(0).Value 'on rappelle la fonction Calcul avec l'ID du père en paramètre
        ptr = Calcul(val) 'et on affecte au ptr la valeur de la fonction
        If ptr = True Then Exit Do 'si ptr = true, on sort de la boucle
    Else: ptr = False 'si l'état du père est false, le ptr reste false et on passe au père suivant
    End If
rst.MoveNext
Loop
 
Calcul = ptr
 
'affecte la valeur de ptr (true/false) dans le champ Alimentation de la table Organes pour l'ID en cours
Dim qdf As DAO.QueryDef
Set qdf = CurrentDb.QueryDefs("QRY_SetAlim")
With qdf
    .Parameters("VALEUR") = ident
    .Parameters("STATE") = ptr
    .Execute
End With
 
'libère les variables
Set qdf = Nothing
Set rst = Nothing
 
'supprime la table temporaire
Dim strSql As String
strSql = "DROP TABLE " & strNameTable
DoCmd.RunSQL strSql
 
Err:
End Function
 
 
'Fonction de création de la table temporaire
Function CreerTable(nomtable As String) As Boolean
On Error GoTo Err
 
Dim oDb As DAO.Database
Dim oNouvelleTable As DAO.TableDef
Dim oChamp As DAO.Field
Dim oIndex As DAO.Index
'Instancie la base de données
    Set oDb = CurrentDb
'Crée la nouvelle table
    Set oNouvelleTable = oDb.CreateTableDef(nomtable)
'Crée le champ Pere
    Set oChamp = oNouvelleTable.CreateField("Pere", dbLong)
'Ajoute le champ à la table
    oNouvelleTable.Fields.Append oChamp
'Crée le champ Etat et l'ajoute
    oNouvelleTable.Fields.Append oNouvelleTable.CreateField("Etat", dbBoolean)
'Crée le champ Alimentation et l'ajoute
   oNouvelleTable.Fields.Append oNouvelleTable.CreateField("Alimentation", dbBoolean)
'Ajoute la table à la base de données
    oDb.TableDefs.Append oNouvelleTable
 
'Libère les variables
oDb.Close
Set oIndex = Nothing
Set oChamp = Nothing
Set oNouvelleTable = Nothing
Set oDb = Nothing
 
CreerTable = True 'la fonction renvoie true si elle a créé la table
 
Err: 'la fonction renvoie false si elle n'a pas pu créer la table (table existante)
End Function
Requête "QRY_SetAlim"
Code sql : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
PARAMETERS VALEUR Long, STATE Bit;
UPDATE Organes SET Organes.Alimentation = [STATE]
WHERE (((Organes.ID)=[VALEUR]));


Je peux d'ores-et-déjà soulever une question :
L'idéal serait d'initialiser toutes les alims à un état indéterminé et d'affecter ensuite la valeur true ou false à l'organe en cours de calcul.
On peut (puisque cela fonctionne) dans une requête, faire "SET Alimentation = NULL" pour un type booléen. Mais je n'ai pas l'impression qu'Access sait gérer le type correctement puisque les alimentations sont mises à la valeur "0" (False).
De ce fait, lorsque l'on tombe sur le cas d'organe père avec Etat = True et Alimentation = False, on ne sait donc pas si cet organe a déjà été calculé ou pas. D'où la bidouille au niveau de la boucle ! On est donc obligé de rappeler à chaque fois la fonction lorsque ce cas se présente.
Quelqu'un sait donc comment affecter réellement la valeur NULL à un booléen dans une table ? Ou il faut passer par une autre solution comme changer le type en integer, ou remplir une table "organes calculés" (qu'on consulterait à chaque passage dans la boucle)