Userform avec fonctions maximiser, minimiser et etirable utilisant les api windows

Soyez le premier à donner votre avis sur cette source.

Snippet vu 17 595 fois - Téléchargée 19 fois

Contenu du snippet

Pour un autre code en cours de développement, j'avais besoin d'avoir un Userform avec les possibilité de dimensionnement d'une fenêtre classique (bouton maximiser, minimiser, etc...).
Afin de pouvoir l'utiliser sur plusieurs Userform, j'ai décidé de mettre ce code sous forme de Classe qui peut alors être incluse dans tout projet existant ou à venir.
Ce code a été développé sur Word 2000. Il est à mon avis compatible Excel et autre version des deux programmes.

Remarque: C'est ma première contribution, alors je suis ouvert à toute critique (constructive, bien sur)
Merci à tous ceux qui postent des codes ici, ils sont une source inépuisable de trucs & astuces (bien plus que l'aide de Micromachin)

Source / Exemple :


'Dans votre projet insérez une classe nommée "UFCustomProperties" dont voici le code:

'*** Définitions des variables locales & fonctions ***
' Fonction d'acquisition de l'identifiant de la fenêtre active
Private Declare Function GAW Lib "user32" Alias "GetActiveWindow" () As Long
' Fonction d'acquisition du titre de la Window hwnd
Private Declare Function GWT Lib "user32" Alias "GetWindowTextA" _
    (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
' Fonction de changement du titre de la Window hwnd (si existant)
Private Declare Function SWT Lib "user32" Alias "SetWindowTextA" _
    (ByVal hwnd As Long, ByVal lpString As String) As Boolean
' Fonction d'acquisition
Private Declare Function GWL Lib "user32" Alias "GetWindowLongA" _
    (ByVal hwnd As Long, ByVal nIndex As Long) As Long
' Fonction de changement
Private Declare Function SWL Lib "user32" Alias "SetWindowLongA" _
    (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

' Déclaration des variables internes
Private Const GWL_STYLE As Long = -16
Private Const WS_THICKFRAME = &H40000       'Cadre fin pour redimensionnement
Private Const WS_MINIMIZEBOX = &H20000      'Bouton "Réduire"
Private Const WS_MAXIMIZEBOX = &H10000      'Bouton "Agrandir"
Private Const WS_MINIMIZED = &H20000000      'Etat Réduit
Private Const WS_MAXIMIZED = &H1000000       'Etat Agrandi
Private Const WS_FULLSIZING = &H70000             'Les 3 propriétés ensembles

Private stTmp As String, lgTmp As Long, lgRet As Long, Whdl As Long

'*** Acquisition du Handle de la Userform ***
'***        pour initialisation           ***
Public Function Initialisation()
    Whdl = GAW
End Function

'*** Définition des propriétés ***
' Bouton Agrandir
Public Property Get MaximizeBox() As Boolean
OldProp = GWL(Whdl, GWL_STYLE) 'Acquisition propriétés
If OldProp = (OldProp Or WS_MAXIMIZEBOX) Then
    MaximizeBox = True
Else
    MaximizeBox = False
End If
End Property
Public Property Let MaximizeBox(Enable As Boolean)
If MaximizeBox <> Enable Then
    OldProp = GWL(Whdl, GWL_STYLE) 'Acquisition propriétés
    SWL Whdl, GWL_STYLE, OldProp Xor WS_MAXIMIZEBOX    'Changement propriétés
End If
End Property
' Bouton Réduire
Public Property Get MinimizeBox() As Boolean
OldProp = GWL(Whdl, GWL_STYLE) 'Acquisition propriétés
If OldProp = (OldProp Or WS_MINIMIZEBOX) Then
    MinimizeBox = True
Else
    MinimizeBox = False
End If
End Property
Public Property Let MinimizeBox(Enable As Boolean)
If MinimizeBox <> Enable Then
    OldProp = GWL(Whdl, GWL_STYLE) 'Acquisition propriétés
    SWL Whdl, GWL_STYLE, OldProp Xor WS_MINIMIZEBOX    'Changement propriétés
End If
End Property
' Etat Agrandi
Public Property Get Maximized() As Boolean
OldProp = GWL(Whdl, GWL_STYLE) 'Acquisition propriétés
If OldProp = (OldProp Or WS_MAXIMIZED) Then
    Maximized = True
Else
    Maximized = False
End If
End Property
' Etat Réduit
Public Property Get Minimized() As Boolean
OldProp = GWL(Whdl, GWL_STYLE) 'Acquisition propriétés
If OldProp = (OldProp Or WS_MINIMIZED) Then
    Minimized = True
Else
    Minimized = False
End If
End Property
' Cadre de re-dimensionnement
Public Property Get ThickFrame() As Boolean
OldProp = GWL(Whdl, GWL_STYLE) 'Acquisition propriétés
If OldProp = (OldProp Or WS_THICKFRAME) Then
    ThickFrame = True
Else
    ThickFrame = False
End If
End Property
Public Property Let ThickFrame(Enable As Boolean)
If ThickFrame <> Enable Then
    OldProp = GWL(Whdl, GWL_STYLE) 'Acquisition propriétés
    SWL Whdl, GWL_STYLE, OldProp Xor WS_THICKFRAME 'Changement propriétés
End If
End Property
' Tous les attributs de Re-dimensionnement
Public Function FullSizing()
    OldProp = GWL(Whdl, GWL_STYLE) 'Acquisition propriétés
    SWL Whdl, GWL_STYLE, OldProp Or WS_FULLSIZING 'Changement propriétés
End Function

' Changement de titre
' ATTENTION: L'utilisation de la propriété "Caption" pour changer
' le titre de la fenêtre inhibe les boutons "Agrandir" & "Réduire"
Public Property Get Title() As String
    'Acquisition Titre pour cohérence avec changement
    'la propriété "Caption" peut être utilisée pour
    'acquérir le titre de la Userform
    stTmp = Space$(120)
    lgTmp = 119
    GWT Whdl, stTmp, lgTmp
    Title = stTmp
End Property
Public Property Let Title(NewTitle As String)
    SWT Whdl, NewTitle
End Property

' Dans un Userform ajoutez le code suivant

Public CustomProperties As UFCustomProperties

'*** Initialisation des propriétés de la fenêtre ***
Private Sub UserForm_Activate()
Set CustomProperties = New UFCustomProperties
Me.CustomProperties.Initialisation   'Acquisition du Handle de la Userform

Me.CustomProperties.FullSizing

' Move la Userform pour faire apparaître les boutons
' Sinon il n'apparaisse qu'aprés avoir bougé la Userform
' Je ne sais pas pourquoi mais c'est comme ça
Me.Left = Me.Left + 1
Me.Left = Me.Left - 1
End Sub

Conclusion :


Dans cet exemple on active toutes les propriétés (fonction "FullSizing")
Le code de la classe permet de les gérer individuellement (utile si on veut interdire le maximiser etc...)

ATTENTION:
L'utilisation de la propriété "Caption" pour changer le titre de la fenêtre inhibe les boutons "Agrandir" & "Réduire", utilisez alors UFCustomProperties.Title
Enfin, aprés avoir activé ou désactivé les boutons Maximiser et/ou minimiser, il faut bouger la Userform pour raffraichir l'affichage (je ne sais pas pourquoi).

A voir également

Ajouter un commentaire Commentaires
Messages postés
42
Date d'inscription
jeudi 20 septembre 2007
Statut
Membre
Dernière intervention
26 juin 2013

bonjour

pour reconnaitre le handle tu utilise "gaw:du get active windows" je faisais cette même erreur par fainéantise mais par curiosité
essai de faire tourner ta fonction avec plusieurs usf affiché a l'écran tu va voir que tous vont prendre les modifications

utilise plutôt le findwindowA vbnullstring,me.caption c'est plus précis sur la fenêtre a modifier

au plaisir
Messages postés
36
Date d'inscription
mardi 18 mars 2008
Statut
Membre
Dernière intervention
31 mars 2008

Bonjour,
je suis débutant en VBA et j'aimerai que ma fenêtre s'ouvre en plein écran par défaut, quelqu'un peut me dire comment faire?
Merci d'avance
Messages postés
3
Date d'inscription
samedi 24 mai 2003
Statut
Membre
Dernière intervention
25 novembre 2007

Pour faire apparaitre les boutons Minimiser, Maximiser après les avoir associés à la fenêtre
il suffit de redessiner le menu du UserForm avec DrawMenuBar Whdl

La déclaration de la fonction DrawMenuBar :

Private Declare Function DrawMenuBar Lib "user32.dll" (ByVal m_hWnd As Long) As Long

En plus, le fait d'exécuter DrawMenuBar dispense de passer par la propiété Title.
En passant ton code est privé de Option Explicit.

2pme
Messages postés
25
Date d'inscription
mardi 24 juillet 2007
Statut
Membre
Dernière intervention
27 août 2010

Salut cameron91
Je suis novice en VBA (je ne développe que depuis hier sous Excel)
ton code est très interressant, mais je n'arrive pas à interdire le plein écran de ma useform (cela doit être trois fois rien mais comme je ne maitrise pas du tout le code et l'interface, je passe à côté)
Ce que je voudrais faire, c'est soit ne pas afficher le bouton "maximize" ou si cela n'est pas possible, arriver à lire l'évenement quand on appui dessus pour interdire le plein écran de la fenêtre

Merci d'avance à ceux ou celles qui pourront m'aider
Messages postés
2
Date d'inscription
vendredi 27 juillet 2007
Statut
Membre
Dernière intervention
27 juillet 2007

Rebonjour
Je réponds à mon propre message.
J'ai trouver un moyen de faire marcher mon application.

Le problème venait du fait que dans Userform_Inisalize ()
Après avoir mis ce bout de code j'ajoutais des valeurs dans la spreadsheet, puis je lui donnais le focus.
J'ai juste écris le code après l'incrémentation de la spreadsheet.
J'espère que ça pourra aider certains.
et encore merci.

Gyre
Afficher les 16 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.