Discussion :

[mout1234]

Bonjour à tous,

La barre de menu standard d'Access propose automatiquement, dans le menu Fenêtre, un accès à chacune des fenêtres actuellement ouvertes.

J'aimerai avoir dans mon menu personnalisé, le même comportement, sans pour autant avoir les autres commandes du menu Fenêtres, et notamment sans les commandes Masquer et Afficher.


PS: mon appli devra fonctionner sous Access FR et sous Access US.


Merci de votre aide.

[Invité]

Salut

Et en créant ta propre liste avec un menu dans la barre de commande, il y a une liste avec la méthode Additem : http://starec.developpez.com/tuto/ba...mande/#LIV-D-3

Il suffit de tester les formulaires ouvert, je n'ai jamais testé.

De plus tu dois pouvoir enlever des parties de ce menu fenêtre, mais il faut les remettre à la fin, car c'est valable pour Access et non pour la base ouverte.

Philippe

[Arkham46]

Bjr,

Une méthode avec des API pour lire les fenêtres ouvertes.

Dans un module :

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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
 
Option Compare Database
Option Explicit
Option Base 1
 
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
                                       (ByVal hwnd As Long, ByVal lpWindowText As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
                                      (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetFocus Lib "user32" () As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetWindowPos Lib "user32.dll" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
                    ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
 
Private Const GW_CHILD = 5&
Private Const GW_HWNDNEXT = 2&
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const HWND_TOP = 0&
 
Public Function ListWindows(pMenuBar As String, pMenu As String)
Dim lRet As Long
Dim lClassName As String
Dim lWindowText As String
Dim lHwnd As Long
Dim lCpt As Long
Dim loMenu As CommandBarPopup
Dim lPosition As New Collection
Dim lWindows As New Collection
Dim lTable As New Collection
Dim lDb As New Collection
Dim lQry As New Collection
Dim lScript As New Collection
Dim lForm As New Collection
Dim lReport As New Collection
Dim lOther As New Collection
Dim lWindow As Variant
Dim lOldClass As String
' Menu à remplir
Set loMenu = CommandBars(pMenuBar).Controls(pMenu)
' Vide le menu
For lCpt = loMenu.Controls.Count To 1 Step -1
    loMenu.Controls(lCpt).Delete
Next
' Lecture de la première fenêtre fille
lHwnd = GetWindow(FindWindowEx(Application.hWndAccessApp, 0&, "MdiClient", vbNullChar), GW_CHILD)
' Boucle pour lecture des fenêtre suivantes
Do Until lHwnd = 0
    ' Classe de la fenêtre
    lClassName = Space(255)
    lRet = GetClassName(lHwnd, lClassName, 255)
    lClassName = Left(lClassName, lRet)
    ' Texte de la fenêtre
    lWindowText = Space(255)
    lRet = GetWindowText(lHwnd, lWindowText, 255)
    lWindowText = Left(lWindowText, lRet)
    ' Rempli la collection en fonction de la classe
    Select Case lClassName
        Case "oForm"
            lForm.Add Array(lHwnd, lClassName, lWindowText)
        Case "oTable"
            lTable.Add Array(lHwnd, lClassName, lWindowText)
        Case "oDb"
            lDb.Add Array(lHwnd, lClassName, lWindowText)
        Case "OReport"
            lReport.Add Array(lHwnd, lClassName, lWindowText)
        Case "OQry"
            lQry.Add Array(lHwnd, lClassName, lWindowText)
        Case "OScript"
            lScript.Add Array(lHwnd, lClassName, lWindowText)
        Case Else
            lOther.Add Array(lHwnd, lClassName, lWindowText)
            Debug.Print lWindowText, lClassName
    End Select
    ' Passe à la fenêtre suivante
    lHwnd = GetWindow(lHwnd, GW_HWNDNEXT)
Loop
' Rempli la collection lWindows en ajoutant chaque objet
' Modifiez l'ordre des appels pour trier le menu différemment
FillWindowsCollection lWindows, lDb
FillWindowsCollection lWindows, lTable
FillWindowsCollection lWindows, lForm
FillWindowsCollection lWindows, lReport
FillWindowsCollection lWindows, lQry
FillWindowsCollection lWindows, lScript
FillWindowsCollection lWindows, lOther
' Boucle sur chacune des fenêtres
lCpt = 0
For Each lWindow In lWindows
    ' Compteur de fenêtre
    lCpt = lCpt + 1
    ' Ajout d'un bouton au menu
    With loMenu.Controls.Add(msoControlButton, , , , True)
        ' Texte du bouton avec numéro en raccourci
        .Caption = "&" & lCpt & " " & lWindow(3)
        ' Style = bouton avec icône et texte
        .Style = msoButtonIconAndCaption
        ' Si fenêtre active => bouton appuyé
        If IsWindowActive(lHwnd) Then .State = msoButtonDown
        ' Action sur click = active la fenêtre
        .OnAction = "=ActivateWindow(" & lWindow(1) & ")"
        ' Image de bouton en fonction de la classe de fenêtre
        Select Case lWindow(2)
            Case "oForm"
                .FaceId = 502
            Case "oTable"
                .FaceId = 498
            Case "oDb"
                .FaceId = 577
            Case "OReport"
                .FaceId = 587
            Case "OQry"
                .FaceId = 585
            Case "OScript"
                .FaceId = 588
            Case Else
                'Debug.Print lWindow(3), lWindow(2)
        End Select
        ' Début de groupe à chaque changement de classe
        If lWindow(2) <> lOldClass Then .BeginGroup = True
    End With
    ' Conserve le nom de classe pour rupture
    lOldClass = lWindow(2)
Next
End Function
 
' Ajoute les éléments de pObjects à la collection pWindows
Private Function FillWindowsCollection(pWindows As Collection, pObjects As Collection)
Dim lObject As Variant
For Each lObject In pObjects
    pWindows.Add lObject
Next
End Function
 
' Active une fenêtre
Public Function ActivateWindow(pHwnd As Long)
SetWindowPos pHwnd, 0, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Function
 
' Vérifie si une fenêtre est active
Private Function IsWindowActive(pHwnd As Long) As Boolean
Dim lHwnd As Long
lHwnd = GetFocus
While lHwnd <> 0
    If lHwnd = pHwnd Then
        IsWindowActive = True
        Exit Function
    End If
    lHwnd = GetParent(lHwnd)
Wend
End Function

Sur action (onAction) du menu à remplir :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
=ListWindows("menu bar","WindowsList")

Pour par exemple remplir le menu "WindowsList" situé sur la barre de menu "menu bar".

En bonus il y a un regroupement par type de fenêtre et des icones :

[mout1234]

Merci les amis!


A dire vrai je dois aller à l'essentiel pour ce projet ... j'espérais être passé à côté d'une solution très simple pour utiliser le mécanisme intrinsèque du menu fenêtre d'Access, sans devoir gérer soit même la barre d'outils, ce que je n'ai jamais l'occasion de faire jusqu'à maintenant.

Mais ... ma curiosité l'emporte je vais de ce pas essayer ces deux pistes ...

Pour info, j'utilise pour ce projet une collection pour gérer une liste de formulaires (multiples instances des mêmes formulaires) je souhaite ainsi permettre à l'utilisateur de passer facilement d'une fenêtre à l'autre. De fait, je sais quels formulaires ajouter / enlever du menu...

Je vais voir comment je peux profiter de cela pour adapter vos solutions et voir laquelle s'adapte le mieux.


A+,
Mout