XL 2021 VBA - Comment savoir dans quel mode (vbModal / vbModeless) est affiché un UserForm

[Dudu2]

Bonjour,

A part tenter un ré-affichage vbModeless pas très satisfaisant, comment savoir le mode d'affichage d'un UserForm ?

 

[Dudu2]

Oui c'est ça.
Le plus délicat est de gérer les resize et les move du classeur pour faire suivre le titre.
Pour le resize c'est un évènement comme le autres donc pas de problème.
Pour le move Il faut in SetWinEventHook() et gérer les EVENT_SYSTEM_MOVESIZESTART et EVENT_SYSTEM_MOVESIZEEND.
Ce fichier donne un exemple d'interception des évènements de move.
Comme c'est du Hooking, parfois (je n'ai pas réussi à identifier le cas et l’empêcher) le déplacement d'une fenêtre de Find/Replace dans le VBE plante la totale.

Fichier: voir plus loin.

 

[patricktoulon]

re
oui j'imagine

 

[dysorthographie]

Bonsoir,

Function EstModal() As Boolean
    On Error GoTo EstModalLabel
    Application.EnableEvents = False
    EstModal = False  ' Si pas d'erreur, le formulaire est modeless
    Exit Function
EstModalLabel:
    EstModal = True   ' Si erreur, le formulaire est modal
End Function

De mémoire pas testé ai quand même demandé confirmation à chatgpt

 

[Dudu2]

Bonjour,
Ça peut servir pour savoir s'il y a un UserForm Modal. Ceci dit quand on veut afficher un Modeless alors qu'un Modal est présent on récupère l'erreur 401. Dans les 2 cas on ne sait pas de quel UserForm Modal il s'agit.

Sub a()
    Dim UserForm As Object
    
    'Loop through all loaded userforms
    For Each UserForm In VBA.UserForms
        If EstModal(UserForm) Then Exit For
    Next UserForm
    
    If Not UserForm Is Nothing Then
        Select Case UserForm.Name
            Case "toto"
                'Celui-là je peux le fermer direct
                Unload UserForm
                
            Case "titi"
                MsgBox "Répondez d'abord à la question du formulaire " & UserForm.Name & " pour continuer"
                Exit Sub
        End Select
    End If
    
    MonUserFormModeless.Show vbModeless
End Sub

 

[jurassic pork]

Bonjour,
Ça peut servir pour savoir s'il y a un UserForm Modal. Ceci dit quand on veut afficher un Modeless alors qu'un Modal est présent on récupère l'erreur 401. Dans les 2 cas on ne sait pas de quel UserForm Modal il s'agit.

Hello,
et si tu testes celui qui est dans l'état "prêt pour une interaction utilisateur" :

Function IsReady4UI(TitreFen) As Integer
 Dim c As New CUIAutomation, oExcel As IUIAutomationElement, oUSF As IUIAutomationElement
  Set oExcel = c.ElementFromHandle(ByVal Application.ActiveWindow.hwnd)
  Set oUSF = GetUiElem(c, oExcel, "Name", TitreFen, TreeScope_Children)
  Debug.Print oUSF.CurrentName
  ' Running = 0  - ReadyForUserInteraction = 2
  IsReady4UI = oUSF.GetCurrentPropertyValue(UIAutomationClient.UIA_WindowWindowInteractionStatePropertyId)
End Function

Function GetUiElem(c As CUIAutomation, _
                       Parent As IUIAutomationElement, _
                       TypeCondition, _
                       ValCondition, _
                       ByVal TreeScope As TreeScope) As IUIAutomationElement
Dim x As Integer, obj As IUIAutomationElement, Condition As IUIAutomationCondition
x = 0
Select Case TypeCondition
    Case "Name"
          Set Condition = c.CreatePropertyCondition(UIAutomationClient.UIA_NamePropertyId, ValCondition)
    Case "AutoId"
          Set Condition = c.CreatePropertyCondition(UIAutomationClient.UIA_AutomationIdPropertyId, ValCondition)
    Case "Class"
          Set Condition = c.CreatePropertyCondition(UIAutomationClient.UIA_ClassNamePropertyId, ValCondition)
    Case "CtrlType"
          Set Condition = c.CreatePropertyCondition(UIAutomationClient.UIA_ControlTypePropertyId, ValCondition)
    Case Else
          Set Condition = c.CreateTrueCondition
    End Select
Set GetUiElem = Parent.FindFirst(TreeScope, Condition)
End Function

Ami calmant, J.P

 

[Dudu2]

Bonjour,
UserForm1 vbModeless et UserForm2 vbModeless -> IsReady4UI(UserForm1) = 2 et IsReady4UI(UserForm2) = 2
UserForm1 vbModal et UserForm2 vbModal -> IsReady4UI(UserForm1) = 0 et IsReady4UI(UserForm2) = 2
UserForm1 vbModeless et UserForm2 vbModal -> IsReady4UI(UserForm1) = 0 et IsReady4UI(UserForm2) = 2

 

[Dudu2]

En fait, si on ne peut pas savoir dans l'état de nos recherches le ShowMode de tous les UserForms on peut au moins savoir celui du dernier affiché.
D'ailleurs si il y a une erreur 401 sur un Show vbModeless, ce ne peut être qu'à cause du dernier et des précédents si on fermer le dernier.

Il faut tester le GetWindowLong du Parent du UserForm (l'application qui l'a chargé) et vérifier son WS_DISABLED.

Option Explicit

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
    #Else
        Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
    #End If
    Private Declare PtrSafe Function GetParent Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
#Else
    Private Declare Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
#End If

Private Const GWL_STYLE = -16
Private Const WS_DISABLED = &H8000000

Sub Test()
    MsgBox LastVisibleUserFormIsModal
End Sub

'------------------------------------------------------------
'Returns True is the last visible UserForm displayed is Modal
'------------------------------------------------------------
Private Function LastVisibleUserFormIsModal() As Boolean
#If VBA7 Then
    Dim hWnd As LongPtr
#Else
    Dim hWnd As Long
#End If
    Dim UserForm As Object
      
    'Get last displayed and visible UserFom
    Set UserForm = GetLastVisibleUserForm
  
    If Not UserForm Is Nothing Then
        'UserForm Handle
        hWnd = GetUserFormHandleByTempFrame(UserForm)
        'UserForm Parent Handle (the Application that loaded it)
        hWnd = GetParent(hWnd)
      
        'Return value
        LastVisibleUserFormIsModal = CBool(GetWindowLongPtr(hWnd, GWL_STYLE) And WS_DISABLED)
    End If
End Function

'---------------------------------------
'Get the last visible UserForm displayed
'---------------------------------------
Private Function GetLastVisibleUserForm() As Object
    Dim i As Integer
  
    If VBA.UserForms.Count > 0 Then
        For i = VBA.UserForms.Count To 1 Step -1
            If VBA.UserForms(i - 1).Visible Then Exit For
        Next i
      
        If i >= 1 Then
            'Return value
            Set GetLastVisibleUserForm = VBA.UserForms(i - 1)
        End If
    End If
End Function

'--------------------------------------
'Get UserForm Handle by Temporary Frame
'--------------------------------------
#If VBA7 Then
    Function GetUserFormHandleByTempFrame(UserForm As Object) As LongPtr
#Else
    Function GetUserFormHandleByTempFrame(UserForm As Object) As Long
#End If
    Dim Frame As MSForms.Control
  
    Set Frame = UserForm.Controls.Add("forms.Frame.1")
    Frame.Left = UserForm.InsideWidth + 1
    GetUserFormHandleByTempFrame = GetParent(GetParent(Frame.[_GethWnd]))
    UserForm.Controls.Remove Frame.Name
End Function

 

[Dudu2]

Bonjour,
Ou peut-être plus simple encore.
Dans le cadre d'une instance Excel, si un UserForm Modal est affiché, il est l'ActiveWindow sauf si le code a fait un SetActiveWindow() ou SetForegroundWindow() sur une autre Window qui de toutes façons sera en WS_DISABLED à cause du UserForm Modal.

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function GetWindowLongPtr Lib "User32" Alias "GetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
    #Else
        Private Declare PtrSafe Function GetWindowLongPtr Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
    #End If
    Private Declare PtrSafe Function GetActiveWindow Lib "user32.dll" () As LongPtr
    Private Declare PtrSafe Function GetParent Lib "User32" (ByVal hWnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetClassName Lib "User32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassname As String, ByVal nMaxCount As Long) As Long
#Else
    Private Declare Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function GetActiveWindow Lib "user32.dll" () As LongPtr
    Private Declare Function GetParent Lib "user32" (ByVal hWnd 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
#End If

Private Const GWL_STYLE = -16
Private Const WS_DISABLED = &H8000000

Sub Test2()
    MsgBox ModalUserFormIsShowing
End Sub

'---------------------------------------------
'Returns True if a Modal UserForm is displayed
'---------------------------------------------
Private Function ModalUserFormIsShowing() As Boolean
#If VBA7 Then
    Dim hWnd As LongPtr
#Else
    Dim hWnd As Long
#End If
    Dim ClassName As String
 
    'Get Active Window and its Class Name
    hWnd = GetActiveWindow
    ClassName = GetWindowClassName(hWnd)
 
    'Active Window is a UserForm
    If (ClassName = "ThunderDFrame" Or ClassName = "ThunderXFrame") Then
        'UserForm Parent Handle (the Application that loaded it)
        hWnd = GetParent(hWnd)
    End If
     
    'Return value
    ModalUserFormIsShowing = CBool(GetWindowLongPtr(hWnd, GWL_STYLE) And WS_DISABLED)
End Function

'------------------------
'Class name of the Window
'------------------------
#If VBA7 Then
    Private Function GetWindowClassName(hWnd As LongPtr) As String
#Else
    Private Function GetWindowClassName(hWnd As Long) As String
#End If
    Dim Buffer As String
    Dim Count As Integer
    Const MAXLEN = 255

    Buffer = String$(MAXLEN - 1, 0)
    Count = GetClassName(hWnd, Buffer, MAXLEN)
 
    'Return value
    If Count > 0 Then
        GetWindowClassName = Left$(Buffer, Count)
    End If
End Function

 

[patricktoulon]

Bonjour
re
tu en est arrivé a la même conclusion que moi en post #27
un userform affiché modal prend le dessus
et normalement dans le getwindow du getdesktop(0) (argument ws_child )il doit être le premier

cela dit sachant que toute fonction ou macro vba , ne peut être lancée que par lui puisqu'il est modal je m’interroge toujours sur le besoin ou même la fiabilité d'une telle fonction, je ne suis pas sur que cela soit aussi easyfriend que cela 😉

 

[Dudu2]

cela dit sachant que toute fonction ou macro vba , ne peut être lancée que par lui puisqu'il est modal je m’interroge toujours sur le besoin

Je suis parti du cas réel de l'ouverture d'un classeur lorsqu'un UserForm Modal est actif.
Dans mon application, cela déclenche un ou plusieurs évènements dans une classe Application qui lancent un traitement qui se déroule malgré la présence du UserForm Modal. En l'occurrence la tentative d'afficher un UserForm vbModeless Titre du classeur qui ne peut évidemment aboutir à cause de la présence du UserForm vbModal (erreur 401).

Donc dire que rien ne peut être lancé n'est pas exact car les traitements:
- issus d'évènements
- issus d'un OnTime ou d'un Timer (lancé avant le Show vbModal)
- autres cas ?
s'exécutent bien.

Savoir qu'un UserForm Modal est actif dans ces cas et pouvoir éventuellement l'identifier, est utile pour par exemple (c'est ce que j'ai fait) ramener l'affichage sur le UserForm et inviter l'utilisateur à y répondre si besoin, ou sinon le fermer directement.

Edit: d'ailleurs je trouve "abusif" de la part d'Excel de bloquer (erreur 401) l'affichage d'un UserForm vbModeless dans une application qui n'est pas celle du UserForm vbModal. Le Modal ne devrait être bloquant que pour l'application qui l'a lancé. Excel a sûrement ses raisons.

 

[patricktoulon]

re

Donc dire que rien ne peut être lancé n'est pas exact car les traitements:
- issus d'évènements oui du userform modal lui même

- issus d'un OnTime ou d'un Timer non pas chez moi !! si le userform est modal et AFFICHE !! meme ontime n'aboutie pas (testé)
le timer si tu fait référence au set timer donc en addressof oui peut être

- autres cas ?
s'exécutent bien.

pour les autres cas j'en vois pas d'autres a partir du moment ou seul le userform modal par ses events ou sub peut appeler d’autres macros dans les modules si on ne parle pas d'addressof alors c'est mort
en tout cas chez moi en 32
tu pense bien que j'ai testé 😉

 

[Dudu2]

Chez moi le OnTime se déclenche.
C'est très étonnant qu'il ne se déclenche pas chez toi malgré nos différences de config !

Option Explicit

Sub a()
    Application.OnTime Now + TimeSerial(0, 0, 2), "b"
    UserForm1.Show vbModal
End Sub

Sub b()
    MsgBox "Ontime déclenché"
    Unload UserForm1
End Sub

 

[patricktoulon]

re
autant pour moi 2 seconde c'est bon
1 seconde ça ne marche pas 1 coup sur 3

 

[Dudu2]

Donc dire que rien ne peut être lancé n'est pas exact car les traitements:
- issus d'évènements oui du userform modal lui même

Non, les évènements en question sont issus d'une classe Application qui sont déclenchés lors de l'ouverture d'un classeur alors qu'un UserForm vbModal est affiché.

Public WithEvents App As Application

Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
Private Sub App_WorkbookActivate(ByVal Wb As Workbook)
Private Sub App_WindowActivate(ByVal Wb As Workbook, ByVal Wn As Window)

 

[patricktoulon]

ok je vois
ca se passe dans l'instance de classe qui reprend les events requis pour ce que tu a faire