[Source] Recherche d'un formulaire/sous-formulaire ouvert

[philben]

bonjour,

A la recherche d'un sous-formulaire précis et pour éviter de me perdre dans le méandre des onglets, des pages et des sous-formulaires, voici une fonction VBA qui retourne une instance du formulaire recherché.

Elle retourne aussi l'éventuel page de l'onglet du sous-formulaire (pour simplifier aussi les écritures) si on veut activer la page en question (Niveau N-2 par rapport au form retourné).

Code

Code :

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
 
'---------------------------------------------------------------------------------------
' Procédure    : GetFormByName  [Function]
' Retour       : Form
' Version      : 1.01
' Auteur       : PhilBen
' Création/Maj : Le samedi 17 mai 2008 à 18:48
' Objet        : Recherche par son nom, un formulaire ouvert :
'              :  - soit comme formulaire principale
'              :  - soit comme sous-formulaire quelque soit le niveau de profondeur
'              :    des controles onglets et sous-formulaire
'              : Retourne une instance sur le premier formulaire trouvé
'              : Retourne aussi l'éventuelle instance du controle page de l'onglet
' Usage        : Simplification des écritures de code VBA pour toutes les actions
'              : liées aux sous-formulaires
' Historique   : v1.01 : correction bug si formulaire principal
'---------------------------------------------------------------------------------------
Public Function GetFormByName(ByVal sNom As String, _
                              Optional ByRef oPage As Control = Nothing) As Form
   Dim oAO As AccessObject
   With CurrentProject
      If .AllForms(sNom).IsLoaded Then
         Set GetFormByName = Forms(sNom) 'v1.01
      Else
         For Each oAO In .AllForms
            If oAO.IsLoaded Then
               Set GetFormByName = GetFormByNameSub(Forms(oAO.Name).Controls, _
                                   sNom, oPage)
               If Not GetFormByName Is Nothing Then Exit For
            End If
         Next oAO
      End If
   End With
End Function
'---------------------------------------------------------------------------------------
' Procédure    : GetFormByNameSub  [Function]
' Retour       : Form
' Version      : 1.01
' Auteur       : PhilBen
' Création/Maj : Le samedi 17 mai 2008 à 18:59
' Objet        : Fonction récursive de recherche du formulaire
' Historique   :
'---------------------------------------------------------------------------------------
Private Function GetFormByNameSub(ByRef oCtrls As Object, ByVal sFormNom As String, _
                                  ByRef oPg As Control) As Form
   Dim oC As Control
   Dim oP As Page
   For Each oC In oCtrls
      If oC.ControlType = acSubform Then
         If oC.SourceObject = sFormNom Then
            Set GetFormByNameSub = oC.Form
         Else
            Set GetFormByNameSub = GetFormByNameSub(oC.Form.Controls, sFormNom, oPg)
         End If
      ElseIf oC.ControlType = acTabCtl Then
         For Each oP In oC.Pages
            Set oPg = oP
            Set GetFormByNameSub = GetFormByNameSub(oP.Controls, sFormNom, oPg)
            If Not GetFormByNameSub Is Nothing Then Exit For
         Next oP
      End If
      If Not GetFormByNameSub Is Nothing Then Exit For
   Next oC
End Function

Exemple d'utilisation
Sur mes pages d'onglet, j'ai une page de recherche avec affichage des données récoltés dans un listbox.
Si l'utilisateur souhaite voir une fiche complète pour édition ou autre qui se trouve sur une autre page de l'onglet , il double-clique sur la ligne souhaitée du listbox.
Par VBA, je recherche le sous-formulaire correspondant, j'active la page de l'onglet pour donner le focus et j'appelle une fonction public du formulaire unique pour afficher la fiche correspondante.
Code de la fonction sur double_clique du ListBox

Code :

1
2
3
4
5
6
7
8
9
10
11
12
 
Private Sub LbPrest_DblClick(Cancel As Integer)
   Dim oFo As Form
   Dim oPg As Control
   If Not IsNull(Me.LbPrest) Then
      Set oFo = GetFormByName  ("SF_GestionPrests_TPrests", oPg)
      oPg.Parent = oPg.PageIndex 'Active la page du formulaire
      oFo.UpdatePosition Me.LbPrest 'Appel la fonction public pour filtrer
   End If
   Set oFo = Nothing
   Set oPg = Nothing
End Sub

Si vous avez plus simple, ça m'intéresse !

Philippe