[Excel-VBA] Bouton réduire du UserForm pour réduire tout le classeur Excel [Résolu]

Signaler
-
 alex90vba -
Bonjour à tous,

Obtenu avec l'aide d'un membre, voici un code pour ajouter les boutons "réduire" et "agrandir" à la fenêtre du formulaire (et plus spécifiquement à chacun des quatre formulaires de mon projet).

Je souhaiterai modifier le code afin que le bouton "réduire" sur la fenêtre du UserForm réduise tout le classeur Excel et non pas seulement le formulaire.

Actuellement le bouton "réduire" réduit le formulaire dans le coin inférieur gauche de l'écran.

Dans un module standard :

Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_STYLE As Long = (-16)         'The offset of a window's style
Public Sub toto(F As Object)
    hWnd = FindWindow(vbNullString, F.Caption)
    iStyle = GetWindowLong(hWnd, GWL_STYLE) Or &H70000
    SetWindowLong hWnd, GWL_STYLE, iStyle
End Sub


Dans chaque UserForm :

Private Sub UserForm_Initialize()
  toto Me
End Sub


L'idée consiste sûrement à récupérer le handle de l'application donc de la fenêtre du classeur Excel, mais je n'y parviens pas.

Merci de votre aide.

16 réponses

Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
236
Dans module
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_STYLE As Long = (-16)         'The offset of a window's style
Public hwnd As Long
Public Sub toto(F As Object)
    hwnd = FindWindow(vbNullString, F.Caption)
    iStyle = GetWindowLong(hwnd, GWL_STYLE) Or &H70000
    SetWindowLong hwnd, GWL_STYLE, iStyle
End Sub


Dans userform :
Private Sub UserForm_Initialize()
  toto Me
End Sub

Private Sub UserForm_Resize()
  'If IsIconic(hwnd) Then Application.WindowState xlMinimized Else Application.WindowState xlNormal
  DoEvents
  If IsIconic(hwnd) Then Application.Visible False Else Application.Visible True
End Sub


Attention : aucun problème avec la propriété Visible (que je te conseille)
Mais si tu choisis de réduire :
1) ton userform ne doit pas être en modal
2) la réduction de ton userform disparaîtra et ne réapparaitra que lorsque tu cliqueras d'abord sur la fenêtre réduite du classeur.

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
236
Bon...
Si tu as choisi de jouer avec la propriété visible ===>> encore plus simple ===>>
Private Sub UserForm_Resize()
  Application.Visible = Not CBool(IsIconic(hwnd))
End Sub



________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
236
As-tu pensé (réflexe à avoir) à regarder dans ton aide VBA les membres de l'objet Application ?
N'y en aurait-il pas un (une propriété) nommé Hwnd ?
Qu'y lis-tu ????


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Exact! J'avais complètement occulté l'aide VBA!
Je regarde ça de suite, merci !
En tout cas là j'ai bien la possibilité d'accepter ta réponse.
Je vais regarder avec l'aide si j'arrive à adapter la macro avec les fonctions
Application.hWnd et GetObject
Merci
(Bien sûr je clôturerai le topic si je trouve
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
236
Je me demande bien à quoi pourrait bien servir GetObject, dans cette affaire.
Tu devrais par contre t'intéresser à l'évènement déclenché (il y en a un) lorsque sont modifiées les dimensions de ton Userform
Tu devrais également te demander s'il ne serait pas par hasard plus utile de jouer avec la propriété Visible (hé oui : elle existe) de ton appli (true ou false selon l'état de la fenêtre de ton userform)
Tu devrais enfin t'intéresser de près à la fonction IsIconic de la librairie user32 de l'Api de Windows. Mon petit doigt me dit qu'elle te renvoie True lorsqu'est réduite la fenêtre concernée (son hwnd).
Le reste est alors tellement évident (jouer avec l'évènement Resize et cette fonction pour décider de ce que tu fais de la fenêtre de ton appli).
Je VEUX te voir jouer avec tout cela.
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Si j'en crois : [http://msdn.microsoft.com/fr-fr/library/windows/desktop/ms633527(v=vs.85).aspx http://msdn.microsoft.com/fr-[b]fr/library/windows/desktop/ms633527(v=vs.85).aspx]

Dans le module de chaque UserForm, j'ai essayé quelque chose comme ça ?

Private hwnd
Private Declare Function IsIconic& Lib "user32" (ByVal hwnd&)


Private Sub UserForm_Resize()
'Dim WdState
'Set WdState Application.WindowState xlNormal
If IsIconic(hwnd) <> 0 Then
        Application.WindowState = xlMinimized
        'Application.Visible = False
        'Else
        'Application.Visible = True
        'Application.WindowState = WdState
        End If
End Sub


Mais ça ne fonctionne pas/b
*et j'ai aussi essayé avec
If IsIconic(hwnd) Then
alternativement
If IsIconic(hwnd) = True Then
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
236
Et pourtant : je viens d'essayer sans problème !
Comment expliques-tu ce fait ?
Allez ! réfléchis un peu : comment faut-il déclarer hwnd dans le module standard pour que cela "marche", hein ? D'après toi ? dès lors que tu utilises hwnd dans :
If IsIconic(hwnd) Then

On va y arriver ! (si tu te réveilles !)


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
IsIconic(ByVal hwnd&)

Je crois que & = As Long
mais lorsque je test ça ne me réduit toujours que le formulaire et pas le classeur Excel...

Donc soit ce n'est pas "As Long" soit je ne vois ?
(ou cela ne fonctionne-t-il que sous certaines versions d'Excel car j'utilise alternativement les 3 versions 97/2003, 2007 et 2010 ?)
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
236
Et où t'ai-je parlé de typage ? Nulle part ! Je t'ai parlé de déclaration !
Et cela n'a pas fait tilt !
Alors regarde :
Ajoute ce msgbox ici, dans ton code :
Private Sub UserForm_Resize()
msgbox hwnd <<<<<<<<<<<<<<<<<<<<<<<<<<<========= ICI
'Dim WdState
'Set WdState Application.WindowState xlNormal
If IsIconic(hwnd) <> 0 Then
Application.WindowState = xlMinimized
'Application.Visible = False
'Else
'Application.Visible = True
'Application.WindowState = WdState
End If
End Sub

Si 0 est affiché : quelle conclusion en tires-tu ???
Bon. Moi, je vais au dodo.
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Quelque chose comme ça alors ?

Dans un module standard :

Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_STYLE As Long = (-16)         'The offset of a window's style


Public hwnd As Long
'à la place de Private hwnd As Long ?
Private IStyle As Long

Public Sub toto(F As Object)
    hWnd = FindWindow(vbNullString, F.Caption)
    iStyle =  GetWindowLong(hWnd, GWL_STYLE) Or &H70000
    SetWindowLong hWnd, GWL_STYLE, iStyle
End Sub



Dans chaque UserForm :

Private hwnd
Private Declare Function IsIconic& Lib "user32" (ByVal hwnd&)

Private Sub UserForm_Initialize()
  toto Me
End Sub

Private Sub UserForm_Resize()
'Dim WdState
'Set WdState  Application.WindowState xlNormal
If IsIconic(hwnd) <> 0 Then
        Application.WindowState = xlMinimized
        'Application.Visible = False
        'Else
        'Application.Visible = True
        'Application.WindowState = WdState
        End If
End Sub
ou bien la valeur 0 n'est-elle pas bonne et il en faudrait une autre ?
ce qui expliquerait que la condition ne se réalise pas et l'application Excel ne se réduise pas (et que le débogage n'identifie aucune erreur)

If IsIconic(hwnd = 0 et il faut différent de 0 ?) <> 0 Then
Application.WindowState = xlMinimized

Mais vu l'heure je verrai demain
Réponse acceptée
C'est le DoEvents qu'il me manquait
MERCI beaucoup pour ton aide, et c'est nettement moins lourd que mon code de départ !
Effectivement, merci :)