USERFORM AVEC FONCTIONS MAXIMISER, MINIMISER ET ETIRABLE UTILISANT LES API WINDOWS

---

Commentaire sur cette source (15)
Ajouter un commentaire et/ou une note

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)

'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

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).

• GESTION DE STOCK
• EXCEL <> AUTOCAD LT
• SHIFUMI EN FORMULAIRE ACCÈSS / CODE VBA
• TRANSFERT DONNÉES ACCESS
• CALCUL ENTHALPIQUE DE L'AIR HUMIDE

• USERFORM PLEIN ÉCRAN SOUS EXCEL VBA
• DÉFINIR TOUS LES CONTRÔLES D'UN USERFORM EN TANT QUE VARIABLES DANS UN TABLEAU (ARRAY)
• LIMITER LE NOMBRE DE LIGNES DANS UN TEXTBOX
• TRAIT SUR USF VBA
• MODIFIER LE MENU SYSTÈME DU FORMULAIRE