XL 2016 VBA - Comment savoir dans le code d'un UserForm s'il a été ouvert en vbModal ou vbModeless ?

[Dudu2]

Bonjour,

La question est dans le titre.

Merci pour toute indication.

Bonne journée.

 

[Dudu2]

J'adore me poser des questions à moi-même.

Et pour ceux qui auraient la même...

'-------------------------------------
'Mode d'affichage du UserForm
'
'- Obj est soit un Control du UserForm
'          soit un UserForm
'
'- Return: vbModal (1)
'          vbModeless (0)
'          Erreur (-1)
'-------------------------------------
Function UserFormShowMode(Obj As Object) As Integer
    On Error Resume Next
    
    If TypeOf Obj Is UserForm Then
        Obj.Show vbModeless
    ElseIf TypeOf Obj.Parent Is UserForm Then
        Obj.Parent.Show vbModeless
    Else
         UserFormShowMode = -1
    End If
    
    If Err.Number = 0 Then
        UserFormShowMode = vbModeless
    Else
        UserFormShowMode = vbModal
    End If
    
    On Error GoTo 0
End Function

 

[patricktoulon]

Bonjour @Dudu2
et si le parent de obj n'est pas directement le userform (une frame ,un multipage , une frame elle même enfant d'une autre frame etc...)
on fait quoi?

 

[Dudu2]

Salut @patricktoulon,

on fait quoi?

J'étais sûr que tu m'interpellerais sur ce sujet auquel j'ai pensé en codant, évidemment.
Ben pour l'instant on fait rien.
A moins de remonter au Parent.Parent.Parent.Parent.
Tu veux que je fasse une boucle pour remonter ?

 

[patricktoulon]

ha ben je suis curieux tiens du comment tu va gérer ça
perso je sais déjà mais peut être a tu une méthode meilleures que celle que j'utilise déjà dans mon calendar par exemple dans la fonction placementcontrol

 

[Dudu2]

J'ai pas de solution miracle. Je fais ça:

'-------------------------------------
'Mode d'affichage du UserForm
'
'- Obj est soit un Control du UserForm
'          soit un UserForm
'
'- Return: vbModal (1)
'          vbModeless (0)
'          Erreur (-1)
'-------------------------------------
Function UserFormShowMode(ByVal Obj As Object) As Integer
    On Error Resume Next
   
    'Init Return Value
    UserFormShowMode = -1
   
    While Not TypeOf Obj Is UserForm
        Set Obj = Obj.Parent
        If Err.Number Then GoTo ExitFunction
    Wend
   
    Obj.Show vbModeless
   
    'Return Value
    If Err.Number = 0 Then
        UserFormShowMode = vbModeless
    Else
        UserFormShowMode = vbModal
    End If
   
ExitFunction:
    On Error GoTo 0
End Function

 

[Dudu2]

Et toi, t'as autre chose ?
Je sais que c'est un sujet dont on a déjà discuté mais je ne sais plus lequel.

 

[patricktoulon]

re
tiens
en fait il te faut remonter le parent avant tout test
dans une simple boucle do while
et ce n'est qu'ensuite que tu peux tester en mettant une reserve ici 200 tours de boucle
ca devrait pas mal couvrir les eventuelles imbrication de conctrol (arrière grand père/grand père/parent/enfant/petit fils etc...) a auteur de 200 imbrications
je bloque à 200 tours avec I
si malgré tout au bout de 200 tours obj n'est toujours pas un userform c'est "-1"
la boucle s’arrête aussi à obj="application"
et voila tu peux tester tout et n'importe quoi tu devrais recevoir la réponse adéquate

Sub testNonModal()
    UserForm1.Show 0
End Sub
Sub testModal()
    UserForm1.Show
End Sub
Sub test_avec_un_control_du_userform()    'le meme test est efectué au click sur le bouton dans le userform  en modal
    MsgBox UserFormShowMode(UserForm1.CommandButton1)
End Sub
Sub test_avecquelquechose()    'pour provoquer une erreur on injecte n'importe quoi
    MsgBox UserFormShowMode([A1])

    Dim toto As Object
    MsgBox UserFormShowMode(toto)

    MsgBox UserFormShowMode(ActiveSheet)

End Sub


'-------------------------------------
'Mode d'affichage du UserForm
'
'- Obj est soit un Control du UserForm
'          soit un UserForm
'
'- Return: vbModal (1)
'          vbModeless (0)
'          Erreur (-1)
'-------------------------------------
Function UserFormShowMode(Obj As Object) As Integer
    Dim I&
    On Error Resume Next
    If Not TypeOf Obj Is UserForm Then
        Do While TypeName(Obj) <> "UserForm" And I < 200 Or TypeName(Obj) <> "Application": I = I + 1: Set Obj = Obj.Parent
            Debug.Print TypeName(Obj)
            If Err.Number > 0 Then Err.Clear: Exit Do
        Loop
    End If

    'on teste quand meme  typeof  userform au cas ou la boucle aurait atteint 200 sans trouver le parent userform avec l'obj injecté
    ' le 200eme parent d'un control devrait couvrir pas mal la remonter si controls beaucoup imbriqué  :) LOL!!!
    If Not TypeOf Obj Is UserForm Then UserFormShowMode = -1: Exit Function Else Obj.Show vbModeless

    If Err.Number = 0 Then UserFormShowMode = vbModeless Else UserFormShowMode = vbModal

    On Error GoTo 0
End Function

voila

 

[Dudu2]

@patricktoulon,
Comme je te l'ai dit dans une autre sujet à propos de ton code ci-dessus, je ne vois pas trop ce que ça apporte par rapport au mien, plus simple.

Le compteur à 200 est pour moi inutile, vu que de toutes façons un Set Obj = Obj.Parent finira toujours pas se planter quand on arrive au sommet de la hiérarchie des objets, où l'objet au sommet n'a plus de propriété .Parent.

Et si l'objet qu'on cherche (un UserForm) est bien celui qui correspond à l'objet courant, c'est gagné.

 

[patricktoulon]

Le compteur à 200 est pour moi inutile, vu que de toutes façons un Set Obj = Obj.Parent finira toujours pas se planter quand on arrive au sommet de la hiérarchie des objets, où l'objet n'a plus de propriété .Parent.

c'est pour ce la que je l’arrête à "application et j'ai fait une erreur c'est "And" et non "Or"
' la flemme de corriger hier)

je ne vois pas trop ce que ça apporte par rapport au mien, plus simple.

heu si quand même!!!! tu ne travaille qu'avec les enfants directs du userform moi je peux commencer tout en bas et remonte tout en haut

 

[Dudu2]

C'est déjà assez dur de s'occuper de ses propres enfants, s'il faut en plus s'occuper des gosses des autres !

 

[patricktoulon]

la mienne est grande maintenant
encore quelques année et c'est elle qui tiendra la cuillère

 

[patricktoulon]

 

[Dudu2]

Tu as mis le doigt sur quelque chose d'inattendu !
Si Obj est un Frame TypeOf Obj Is UserForm = True !!!

Je trouve cela très étrange et je ne sais pas si cela fait sens mais je dirais que c'est un bug car le TypeOf Frame existe bel et bien.

Le bon code est donc:

'-------------------------------------
'Mode d'affichage du UserForm
'
'- Obj est soit un Control du UserForm
'          soit un UserForm
'
'- Return: vbModal (1)
'          vbModeless (0)
'          Erreur (-1)
'-------------------------------------
Function UserFormShowMode(ByVal Obj As Object) As Integer
    On Error Resume Next
    
    'Cherche l'objet au sommet de la hiérarchie
    Do While Err.Number = 0
        Set Obj = Obj.Parent
    Loop
    
    If Not TypeOf Obj Is UserForm Then
        UserFormShowMode = -1
    Else
        Err.Clear
        Obj.Show vbModeless
        
        'Return Value
        If Err.Number Then
            UserFormShowMode = vbModal
        Else
            UserFormShowMode = vbModeless
        End If
    End If
    
    On Error GoTo 0
End Function

 

[patricktoulon]

re
Bonjour @Dudu2
oui je sais avec les frames selon la version d'excel il y a des non cohérences avec les fonctions
je pense que justement comme les frames ont un handle window ,(et oui!!elle sont des window a part entière)
peut être que Ms a modifié pour palier justement a ça et pouvoir utiliser les fonctions pour control sur elles

car les autres controls a part listbox , multipage n'ont pas de handle
tout du moins les api te donnent le même pour tous

maintenant met un autre object a la place du control dans l'appel
et shbountch!!! ça tourne sans fin c'est pour ca que j’arrête l'a boucle a application