[VBA/Excel] Boutons réduire et agrandir pour UserForm [Résolu/Fermé]

Messages postés
33
Date d'inscription
lundi 3 mars 2008
Statut
Membre
Dernière intervention
14 décembre 2012
- - Dernière réponse : alecomte
Messages postés
33
Date d'inscription
lundi 3 mars 2008
Statut
Membre
Dernière intervention
14 décembre 2012
- 14 déc. 2012 à 21:44
Bonjour,

Le code ci-après permet d'ajouter les boutons réduire et agrandir à côté de la croix rouge d'un UserForm.
Seulement mon projet ne contient pas un mais quatre formulaires.

Après test les lignes UserForm1.Hide et UserForm1.Show me semblaient inutiles donc je les ai supprimées.

Avec un projet n'ayant qu'un formulaire, le code fonctionne toujours, pas de problèmes.
Mais avec plusieurs formulaires :
- le bouton agrandir fonctionne OK
- Mais le bouton réduire pose problème.

Si je clique sur le bouton réduire une fois, ç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 ? (et plus précisément le bouton réduire) ?

Merci de votre aide !


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
Afficher la suite 

12 réponses

Meilleure réponse
Messages postés
33
Date d'inscription
lundi 3 mars 2008
Statut
Membre
Dernière intervention
14 décembre 2012
8
5
Merci
Pour mettre tout le monde d'accord ;)

Simplicité et efficacité :

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
Private hWnd, IStyle 
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 chaque UserForm :

Private Sub UserForm_Initialize()
  toto Me
End Sub


Et parce que je n'ai pas prétention à voler le travail d'un autre : http://www.vbfrance.com/forum/sujet-VB-EXCEL-USER-FORM-BOUTONS-AGRANDIR-REDUIRE_674590.aspx#6
merci à ucfoutu !

Dire « Merci » 5

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 65019 internautes nous ont dit merci ce mois-ci

Messages postés
1492
Date d'inscription
vendredi 26 octobre 2012
Statut
Membre
Dernière intervention
28 janvier 2013
78
2
Merci
Bonsoir alecomte, lermite222,

Ok, le code fonctionne très bien pour les quatres formulaires, mais lermite222 n'a pas tort.
Rends-toi compte par toi-même, son code ne prend que quelques lignes, avec, en prime, un minuscule appel par formulaire .. question poids, clarté et efficacité, y'a pas mieux !
A toi de voir !
Messages postés
8713
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
27 janvier 2014
1006
1
Merci
Bonjour,
En fait ce que tu veux ce sont les boutons système pour minimiser et maximiser tes UF ?
Si oui, façon beaucoup plus simple pour y arriver
Si tu est sur excel 97-2003 tu supprime les lignes qui ont rapport avec le zoom qui n'est pas disponible dans ces versions, du moins dans le 2000.
A+


Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
NOTE : Je ne répond pas aux MP pour les questions techniques.
Heliotte
Messages postés
1492
Date d'inscription
vendredi 26 octobre 2012
Statut
Membre
Dernière intervention
28 janvier 2013
78 -
Bonsoir lermite222,
Le temps de créer un test, j'ai oublié de raffraichir, et de ce fait .. j'ai répondu sans avoir vu votre réponse.
Toutes mes excuses.
Messages postés
8713
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
27 janvier 2014
1006
1
Merci
beh essaye ma proposition et t'auras plus de problème, prend au moins la peine d'y regarder. Mais bon, c'est toi qui vois.
Après tout, si tu préfère 50 lignes de code à la place de trois....Grrr

Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
NOTE : Je ne répond pas aux MP pour les questions techniques.
Messages postés
33
Date d'inscription
lundi 3 mars 2008
Statut
Membre
Dernière intervention
14 décembre 2012
8
0
Merci
En supposant garder les lignes,
UserForm1.Hide
UserForm1.Show
J'ai pensé que peut-être une boucle du style :
Dim Usf as UserForm
For i = 1 to 4
Usf & i ...
mais la définition de variable As UserForm nécessite d'utiliser un module de classe qui renvoie alors une erreur sur
Public Const GWL_WNDPROC& = -4&, WM_SYSCOMMAND& = &H112&
due à une impossibilité d'avoir une constante dans un module de classe..
Messages postés
1492
Date d'inscription
vendredi 26 octobre 2012
Statut
Membre
Dernière intervention
28 janvier 2013
78
0
Merci
Bonsoir alecomte,

Je ne comprend pas où est le problème, car chez moi tout fonctionne super bien .. seul blême, c'est quand on réduit le formulaire, il le place sur le bureau (coin inférieur gauche) .. pas très zoli, mais bon.

Alors, s'il faut faire des test, va falloir passer les commandes .. le classeur MAIS sans les données confidentielles, comme d'habitude, par exemple sur http://www.cjoint.com/

Au plaisir
Messages postés
33
Date d'inscription
lundi 3 mars 2008
Statut
Membre
Dernière intervention
14 décembre 2012
8
0
Merci
@Heliotte

Que fais-tu des lignes UserForm1.Hide et UserForm1.Show ?

Car je précise bien que j'ai un bugg en ayant plusieurs formulaires seulement !
Et bizarrement seulement avec le bouton réduire du formulaire au 2ème clic ?!

(alors qu'avec un seul formulaire dans mon projet et tout fonctionne nickel)

Je réessaie en rentrant et t'envoie un fichier test via http://www.cjoint.com/


@lermitte22

Je suis à la fois sur Excel 2007 et 2010 (chez moi) et sur 97/2003 (au travail).
Mais je rencontre le même bugg sur les 3 versions !


Merci à tous les deux
Messages postés
33
Date d'inscription
lundi 3 mars 2008
Statut
Membre
Dernière intervention
14 décembre 2012
8
0
Merci
Merci pour vos réponses (et votre réactivité !) je regarde ça et je vous tiens au courant ;)
Messages postés
33
Date d'inscription
lundi 3 mars 2008
Statut
Membre
Dernière intervention
14 décembre 2012
8
0
Merci
lermite222, je trouve ton code succinct très bien, bravo !
Toutefois le zoom est un peu exagéré et surtout inégal pour mon formulaire : certains caractères grossissent plus que d'autres (même si ce détail est négligeable).

L'avantage du code modifié par Heliotte est qu'en évitant le zoom, l'agrandissement plein écran me permet d'afficher davantage de contenu du formulaire à l'écran.
Par ailleurs je trouve la fonction réduire plus adaptée. On peut se demander où est passé le formulaire avec ta méthode... même si je l'ai rapidement trouvé grâce au commentaire d'Heliotte.

Finalement, je pense que chacun tranchera selon son formulaire (et peut-être sa vue lol) ! Je vais moi-même garder les deux possibilités et je jugerai au cas par cas ! Donc un grand merci à tous les deux :) !

N.B. : Ceci dit, je crois avoir lu que ton code lermite222 ne fonctionnait qu'à partir de la version Excel 2007... alors avec mon Excel 2003 du travail, je pense m'orienter vers le premier code pour le formulaire présent.
Messages postés
1492
Date d'inscription
vendredi 26 octobre 2012
Statut
Membre
Dernière intervention
28 janvier 2013
78
0
Merci
Bonjour alecomte,

Je tiens à te rassurer.
Le code de lermite222 fonctionne super bien sur un classeur Excel version 2003
Messages postés
8713
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
27 janvier 2014
1006
0
Merci
Ça c'est vraiment pour te f.....e de la G....e des gens. grrrf<f&zhuzuzoulou
C'est exactement ce que je propose dans ma démo avec en plus ont peu choisir les boutons que l'ont veux ajouter. Et cerise sur le gâteau, les double fléchés pour dimensionner par l'utilisateur.
Je met bien tes pseudo de côté, et fait moi confiance, ont ne m'y reprendra plus à vouloir t'aider et vu ton poste sur CS tu a encore beaucoup de lacune
A++
alecomte
Messages postés
33
Date d'inscription
lundi 3 mars 2008
Statut
Membre
Dernière intervention
14 décembre 2012
8 -
Excuse-moi mais effectivement j'ai constaté que ce code comme le tien ne permettait pas de réduire le classeur mais seulement le formulaire. Donc tu regarde bien sur le lien, je cherche toujours à modifier les deux codes (ta proposition et celle de ucfoutu) pour vraiment récupérer le handle de la fenêtre Excel à réduire ;)

Les lignes de code n'étant pas rigoureusement les mêmes sur vos deux codes (mais je finis pas m'y perdre), j'ai pensé que tu aurais aimé avoir connaissance de la méthode qu'on m'avait évoquée par ailleurs. Donc loin de moi l'idée de t'offusquer qui me surprend même...
alecomte
Messages postés
33
Date d'inscription
lundi 3 mars 2008
Statut
Membre
Dernière intervention
14 décembre 2012
8 -
Désolé, autant pour moi, je suis revenu sur ton code et c'est effectivement rigoureusement le même. A croire que je me suis emmêlé les pinceaux en reprenant les différents codes dans mon fichier de travail. Mais j'ai effectivement des lacunes d'où mon post autrement il serait bien inutile. Donc encore merci pour ton aide et désolé ça partait d'un bon sentiment de te partager la proposition sur CS ;)
lermite222
Messages postés
8713
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
27 janvier 2014
1006 -
Ouais, essaye pas de retomber sur tes pattes c'est trop tard.
Et tu ferais bien de regarder comment fonctionne les forums.
Sur CS je doute que ton "ami" ne te réponde à nouveau, tu n'a même pas pris la peine de valider sa réponse bien qu'il te l'ai demander.
Et ici tu n'a pas pris la peine de marquer ton poste en résolu, j'ai dû le faire pour toi.
Autre remarque, pour ceux qui te réponde rien de plus désobligeant de constater que tu pose la même question sur plusieurs forums et qu'en définitive tu viens nous narguer avec la même réponse que celle que l'ont t'a donné.
Et dommage, le problème que tu dis est tellement simple mais amuse-toi bien.
alecomte
Messages postés
33
Date d'inscription
lundi 3 mars 2008
Statut
Membre
Dernière intervention
14 décembre 2012
8 -
Je t'ai répondu par mp. Mais merci quand même pour l'aide apportée.
Messages postés
8713
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
27 janvier 2014
1006
0
Merci
Bon, suite à tes excuses par Mp je vais considéré que ces quiproquo sont le résultat de ton inexpérience sur les forums.
Quelque règles fondamentales quand même...

Ucfoutu te passe une fonction qui te convient, tu retranscrit et constate des erreurs parce que tu à mis OptionExplicit et qu'il a omis ("Oh affreuse erreur") de déclarer les variables. ta réponse à la place d'être un remerciement est , d'accord merci, mais est plutôt le reproche de dire... t'est pas foutu de me mettre qué chose de convenable..

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

Tu crois que c'est agréable de recevoir cela?? pose-toi la question. ET évite de faire le malin, oublie pas que c'est toi qui est demandeur.

2) Pose une question sur UN forum et SUIT LE, si ont te donne des pistes, SUIT LES.
Si en finale, tu n'a pas les réponses souhaitées va voir ailleurs mais pas les 2,3 en même temps, ça aussi c'est désobligeant pour les gens qui se décarcasse pour te répondre.

Oublie jamais, les gens qui te réponde sont des bénévoles, il t'aide en fonction de leurs connaissances et de leur disponibilités, évite de les faire passer pour des moins que rien même si la réponse qu'il te donne n'est pas la bonne. Une question peut souvent être interprétée de multiple façons et c'est bien souvent le helpeur qui n'a pas bien énoncer sont problème.

Enfin pour terminer, comme c'est toi qui apprend je te recommande, "humilité" gentillesse" , "patience"

J'espère que tu en prendra de la graine et pour , en finale, montrer que je ne t'en veux plus..
dans l'événement resize de l'UF.
tu trouve la ligne

    If Me.Width < 300 Or Me.Height < 200 Or Fini Then Exit Sub

tu ajoute..

    If Me.Width < 300 Or Me.Height < 200  Then application.WindowsState=0 :  Exit Sub


Mais c'est pas tout à fait juste.. cherche et si c'est pas comme ça que tu veux dis...
Aller.. finalement sans rancune.
Note : J'ai pas l'habitude de faire tout un roman mais je pense que tu est jeune et qu'en regard de tes MP tu mérite, du moins de ma part, une deuxième chance.
A+
alecomte
Messages postés
33
Date d'inscription
lundi 3 mars 2008
Statut
Membre
Dernière intervention
14 décembre 2012
8 -
Merci de ta compréhension.
Quant au problème évoqué, je l'ai finalement résolu, merci ;)