[VBA/Excel] Boutons réduire et agrandir pour UserForm
Résolu
alecomte
Messages postés
37
Statut
Membre
-
alecomte Messages postés 37 Statut Membre -
alecomte Messages postés 37 Statut Membre -
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
Dans le module du UserForm
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
A voir également:
- [VBA/Excel] Boutons réduire et agrandir pour UserForm
- Comment réduire la taille d'un fichier - Guide
- Word et excel gratuit - Guide
- Liste déroulante excel - Guide
- Si et ou excel - Guide
- Reduire taille image - Guide
12 réponses
Pour mettre tout le monde d'accord ;)
Simplicité et efficacité :
Dans un module standard
et dans chaque UserForm :
Et parce que je n'ai pas prétention à voler le travail d'un autre : https://codes-sources.commentcamarche.net/#6
merci à ucfoutu !
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 : https://codes-sources.commentcamarche.net/#6
merci à ucfoutu !
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 !
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 !
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.
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.
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.
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.
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
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..
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..
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 https://www.cjoint.com/
Au plaisir
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 https://www.cjoint.com/
Au plaisir
@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 https://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
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 https://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
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.
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.
Bonjour alecomte,
Je tiens à te rassurer.
Le code de lermite222 fonctionne super bien sur un classeur Excel version 2003
Je tiens à te rassurer.
Le code de lermite222 fonctionne super bien sur un classeur Excel version 2003
Ç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++
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++
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...
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...
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 ;)
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.
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.
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
tu ajoute..
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+
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+