VB Excel User Form - boutons Agrandir et Réduire

Question

Bonjour &#224; tous et merci par avance de vos r&#233;ponses,
 Pouvez vous m'indiquer comment je peux utiliser une user form dot&#233;e des boutons Minimize et Maximize avec VB Excel 2002 SP3

ucfoutu · Accepted Answer

Bonjour,
Bien embrouillé pour ps grand-chose, ce code 

Il suffit de ceci :
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
Et dans userform :

Private Sub UserForm_Initialize()
  toto Me
End Sub


Je ne vais tout de même pas aussi te dire (c'est tellement évident) ce qu'il convient de faire pour plusieurs userforms, hein ... (dans cet exemple : Me est un objet - un userform).



________________________
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.

jrivet · Answer

Salut,

Tu peux peu etre essayer de passer par des Bouttons que tu ferais toi meme et qui auraient la meme fonction que les bouton Min Et Max:

Du Style Pour le Min:  Me.Hide (ou un truc du style)

Et pour le Max: 
Me.Width = Application.Width
Me.Height = Application.Height
Me.Left = Application.Left
Me.Top= Application.Top

Le truc c est qu il faut memoriser les valeur du form pour les remettre au cas ou l utilisateur appuie de nouveau sur Max.

@+, Julien 
Pensez: Moteur de Recherche, R&#233;ponse Accept&#233;e

jpleroisse · Answer

Bonjour,

Ce code fonctionne sur Excel 97, sup&#233;rieur, je ne sais pas.



'Dans un Module



Public Declare Function FindWindow& _

    Lib "user32" Alias "FindWindowA" _

    (ByVal lpClassName$, ByVal lpWindowName$)



Public Declare Function GetWindowLong& _

    Lib "user32" Alias "GetWindowLongA" _

    (ByVal hwnd&, ByVal nIndex&)



Public Declare Function SetWindowLong& _

    Lib "user32" Alias "SetWindowLongA" _

    (ByVal hwnd&, ByVal nIndex&, ByVal dwNewLong&)



Private Declare Function EnableWindow& _

    Lib "user32" _

    (ByVal hwnd&, ByVal fEnable&)



Private Declare Function CallWindowProc& _

    Lib "user32" Alias "CallWindowProcA" _

    (ByVal lpPrevWndFunc&, ByVal hwnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&)



Public Const GWL_WNDPROC& -4&, WM_SYSCOMMAND& &H112&



Public BaseUFProc&, BaseXLProc&, AncState&



Function UFProc&(ByVal hwnd&, ByVal uMsg&, ByVal wParam&, ByVal lParam&)

    Dim HwndXL&

    Const SC_MINIMIZE& = &HF020&

    If uMsg = WM_SYSCOMMAND Then

            If wParam = (SC_MINIMIZE And &HFFF0&) Then

               
HwndXL = FindWindow("XLMAIN", Application.Caption)

                EnableWindow HwndXL, True

                UserForm1.Hide

                AncState = Application.WindowState

                Application.WindowState = xlMinimized

               
BaseXLProc = SetWindowLong(HwndXL, GWL_WNDPROC, AddressOf XLProc)

                UFProc = 1&

                Exit Function

            End If

    End If

    UFProc = CallWindowProc(BaseUFProc, hwnd, uMsg, wParam, lParam)

End Function





Function XLProc&(ByVal hwnd&, ByVal uMsg&, ByVal wParam&, ByVal lParam&)

    Const SC_MAXIMIZE& = &HF030&, _

        SC_RESTORE& &HF120&, SC_CLOSE& &HF060&

    If uMsg = WM_SYSCOMMAND Then

            If
wParam (SC_MAXIMIZE And &HFFF0&) Or wParam (SC_RESTORE _

               
And &HFFF0&) Or wParam = SC_CLOSE Then

               
SetWindowLong hwnd, GWL_WNDPROC, BaseXLProc

                Application.WindowState = AncState

                UserForm1.Show

                XLProc = 1&

                Exit Function

            End If

    End If

    XLProc = CallWindowProc(BaseXLProc, hwnd, uMsg, wParam, lParam)

End Function



'Dans le module du UserForm



Option Explicit

Private HandleUF&



Private Sub UserForm_Initialize()

    Const WS_MAXIMIZEBOX& = &H10000, _

        WS_MINIMIZEBOX& &H20000, GWL_STYLE& -16&

    HandleUF = FindWindow(vbNullString, Me.Caption)

    SetWindowLong HandleUF, GWL_STYLE, _

        GetWindowLong(HandleUF, GWL_STYLE) Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX

    BaseUFProc = SetWindowLong(HandleUF, GWL_WNDPROC, BaseUFProc)

End Sub



Private Sub UserForm_Terminate()

    SetWindowLong HandleUF, GWL_WNDPROC, BaseUFProc

End Sub



jpleroisse



Si une r&#233;ponse vous convient, cliquez R&#233;ponse Accept&#233;e.

fandefan · Answer

Merci &#224; tous les deux,
Je me suis conform&#233; &#224; l'id&#233;e de jrivet ce n'est pas standard mais cela marche toujours bien.
Je vais de ce pas tester la solution de jpleroisse.
Encore merci pour votre disponibilit&#233; et rapidit&#233;.

alex90vba · Answer

Bonjour tout le monde,

Je me permets de revenir sur ce sujet malgré son ancienneté.

J'ai testé la macro proposée par jpleroisse ; elle fonctionne mais pour un seul formulaire. 
Comment faire  pour la faire fonctionner avec plusieurs formulaires.

J'ai essayé de copier-coller cette partie dans chaque module de formulaire (j'en ai quatre).

'Dans le module du UserForm

Option Explicit
Private HandleUF&

Private Sub UserForm_Initialize()
    Const WS_MAXIMIZEBOX& = &H10000, _
        WS_MINIMIZEBOX& &H20000, GWL_STYLE& -16&
    HandleUF = FindWindow(vbNullString, Me.Caption)
    SetWindowLong HandleUF, GWL_STYLE, _
        GetWindowLong(HandleUF, GWL_STYLE) Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX
    BaseUFProc = SetWindowLong(HandleUF, GWL_WNDPROC, BaseUFProc)
End Sub

Private Sub UserForm_Terminate()
    SetWindowLong HandleUF, GWL_WNDPROC, BaseUFProc
End Sub



et j'ai supprimer les lignes
UserForm1.Hide
UserForm1.Show
qui semblent inutiles dans la première partie de code destinée à un module.

Seulement lorsque je clique sur le bouton réduire du formulaire, ça fonctionne la première fois. Mais si je clique à nouveau sur le bouton, ça ferme subitement le classeur Excel et je perds donc toutes mes données non-enregistrées.


Comment puis-je donc faire fonctionner ce code avec plusieurs UserForm ?

Merci de votre aide !

alex90vba · Answer

Tu as oublié la définition des variables
Private hWnd, IStyle
avant la Public Sub toto...
Sinon impeccable MERCI !!!

alex90vba · Answer

Par contre serait-ce possible que le bouton réduire, réduise tout le classeur Excel et non pas seulement le formulaire (comme le code de départ) ?

ucfoutu · Answer

réduise tout le classeur Excel et non pas seulement le formulaire (comme le code de départ)
Oui, mais alors en passant à la sub le hwnd de la fenêtre du classeur.
Mais ne serait-il pas plus adroit d rendre le classeur tout simplement invisible lorsque tu réduis le formulaire ? 


________________________
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.

alex90vba · Answer

Je suis un peu confus là et j'ai peur que ça ne sorte de mon champ de compétences  Pourrais-tu me proposer un code pour les deux cas ? Merci

ucfoutu · Answer

Non !
Je tiens personnellement à voir les autres réfléchir un peu.
Alors : Pour moi : la présente discussion concernait un sujet (qui concernait un userform). Elle a été traitée et résolue.
Elle doit donc être libérée (tag "réponse acceptée").

Si tu as une autre question ===>> autre discussion ! mais cette fois-ci en t'efforçant de montrer tes propres efforts, s'il te plait.


________________________
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.

alex90vba · Answer

alex90vba · Answer

A priori si je demande c'est que j'ai déjà cherché tout seul mais que je n'y parviens pas... enfin merci déjà pour le début de code. 
Sinon le sujet n'est pas de moi donc je ne peux pas en modifier le tag.

alex90vba · Answer

Visiblement le libellé "réponse acceptée" ne s'est accepté qu'en commentaire et pas sur ton post ucfoutu. A défaut de répondre à mon problème, je veux bien savoir comment ajouter le libellé demandé ;)

ucfoutu · Answer

Alors : ouvre ta propre discussion (sur une seule question : soit le userform, soit sur une autre fenêtre ... encore que .. le principe soit rigoureusement le même). ! 


________________________
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.

VB Excel User Form - boutons Agrandir et Réduire

14 réponses

Discussions similaires