Accueil
Accueil Le Club Delphi Kylix C C++ Java J2EE DotNET & C# Visual Basic Access Pascal Dev Web PHP ASP XML UML SQLSGBD Windows Linux Autres
logo

precedent    sommaire    suivant   


Comment trouver le Handle d'une Userform ?
auteur : Bbil
De nombreuses fonctions de l'API Win32, agissant sur les fenêtres, réclament en paramètre le handle (ou identificateur) de la dite fenêtre.
Malheureusement certains applicatifs tels Excel, Word... ne permettent pas de récupérer cette valeur.

la fonction FindWindowA, de l'API Win32, permet de connaître le handle d'une fenêtre à partir de son titre.

Vba
 
Private Declare Function FindWindowA Lib "user32" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  
Private Sub UserForm_Initialize()
Dim MeHwnd As Long
    MeHwnd = FindWindowA(vbNullString, Me.Caption)
    MsgBox "le Handle de l'Userform " & Me.Caption & " est : 0x" & Hex(MeHwnd)
End Sub

Comment inhiber ou masquer le bouton "Fermer" d'une UserForm ?
auteurs : Bbil, ThierryAIM
Vous pouvez avoir besoin d'empêcher la fermeture d'une userform par la croix système.
2 solutions vous sont proposées ci-dessous:

1) La plus simple: inhiber l'action de la croix de fermeture dans l'évènement QueryClose de la UserForm:

Vba
 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = vbFormControlMenu Then Cancel = True
End Sub



2) La plus jolie: masquer le bouton de fermeture de la UserForm :

Vba
 
'-- Dans la partie Déclaration de la Form :
Private Const SC_CLOSE = &HF060&
Private Const MF_BYCOMMAND = &H0&

Private Declare Function GetSystemMenu Lib "user32" _
        (ByVal hwnd As Long, ByVal bRevert As Long) As Long
        
Private Declare Function RemoveMenu Lib "user32" _
        (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long

Private Declare Function FindWindowA Lib "user32" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long


'-- Dans l'évènement Initialise de la Form :
Private Sub UserForm_Initialize()
Dim hSysMenu As Long
Dim MeHwnd As Long
    MeHwnd = FindWindowA(vbNullString, Me.Caption)
    If MeHwnd > 0 Then
        hSysMenu = GetSystemMenu(MeHwnd, False)
        RemoveMenu hSysMenu, SC_CLOSE, MF_BYCOMMAND
    Else
        MsgBox "Handle de " & Me.Caption & " Introuvable", vbCritical
    End If
End Sub

Comment masquer la barre de titre d'une UserForm ?
auteur : Bbil
Il faut utiliser les fonctions de l'API Windows : SetWindowLong, SetWindowPos, GetWindowRect, GetWindowLong et hSysMenu et, pour le cas d'Excel ou Word qui ne donne pas accès au handle de la fenêtre : FindWindowA...

Déclarations à placer dans un module standard :

Vba
 
Public Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Const GWL_STYLE = (-16)
Const WS_CAPTION = &HC00000
Const SWP_FRAMECHANGED = &H20

Public Declare Function FindWindowA Lib "user32" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        
Public Declare Function GetWindowRect Lib "user32" _
        (ByVal hwnd As Long, lpRect As RECT) As Long
        
Public Declare Function GetWindowLong Lib "user32" Alias _
        "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Public Declare Function SetWindowLong Lib "user32" Alias _
        "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, _
        ByVal dwNewLong As Long) As Long

Public Declare Function SetWindowPos Lib "user32" _
        (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, _
        ByVal y As Long, ByVal cx As Long, ByVal cy As Long, _
        ByVal wFlags As Long) As Long


Fonction pour afficher ou masquer la barre de titre d'une UserForm (vous pouvez aussi la placer dans le module) :

Vba

Sub AfficheTitleBarre(stCaption As String, pbVisible As Boolean)
Dim vrWin As RECT
Dim style As Long
Dim lHwnd As Long
'- Recherche du handle de la fenêtre par son Caption
    lHwnd = FindWindowA(vbNullString, stCaption)
    If lHwnd = 0 Then
        MsgBox "Handle de " & stCaption & " Introuvable", vbCritical
        Exit Sub
    End If
    
    GetWindowRect lHwnd, vrWin
    style = GetWindowLong(lHwnd, GWL_STYLE)
    If pbVisible Then
        SetWindowLong lHwnd, GWL_STYLE, style Or WS_CAPTION
    Else
        SetWindowLong lHwnd, GWL_STYLE, style And Not WS_CAPTION
    End If
    SetWindowPos lHwnd, 0, vrWin.Left, vrWin.Top, vrWin.Right - vrWin.Left, _
            vrWin.Bottom - vrWin.Top, SWP_FRAMECHANGED
End Sub


Dans l'évènement Initialize de l'UserForm concernée :

Vba

Private Sub UserForm_Initialize()
'On passe en arguments : 
'    - le titre de la fenêtre
'    - False pour masquer la barre de titre 
    AfficheTitleBarre Me.Caption, False
End Sub

Comment créer un UserForm dynamiquement ?
auteur : SilkyRoad
Cet exemple crée un UserForm et une ListBox par macro, ainsi qu'une macro évènementielle "Click()" pour la ListBox.

Vba

Option Explicit
Dim Usf As Object
 
Sub lancementProcedure()
Dim X As Object
Dim i As Integer
Dim strList As String
 
strList = "ListBox1"
Set X = creationUserForm_Et_listBox_Dynamique(strList)
 
For i = 1 To 10
    X.Controls(strList).AddItem "Donnee " & i
Next i
 
X.Show
 
ThisWorkbook.VBProject.VBComponents.Remove Usf
Set Usf = Nothing
End Sub
Vba

Function creationUserForm_Et_listBox_Dynamique(nomListe As String) As Object
Dim ObjListBox As Object
Dim j As Integer
 
  Set Usf = ThisWorkbook.VBProject.VBComponents.Add(3)
  With Usf
    .Properties("Caption") = "Mon UserForm"
    .Properties("Width") = 300
    .Properties("Height") = 200
  End With
  
Set ObjListBox = Usf.Designer.Controls.Add("Forms.ListBox.1")
      
With ObjListBox
    .Left = 20: .Top = 10: .Width = 90: .Height = 140
    .Name = nomListe
    .Object.ColumnCount = 1
    .Object.ColumnWidths = 70
End With
 
With Usf.CodeModule
    j = .CountOfLines
    .InsertLines j + 1, "Sub " & nomListe & "_Click()"
    .InsertLines j + 2, "If Not " & nomListe & ".ListIndex = -1 Then MsgBox " & nomListe
    .InsertLines j + 3, "End Sub"
End With
 
VBA.UserForms.Add (Usf.Name)
Set creationUserForm_Et_listBox_Dynamique = UserForms(UserForms.Count - 1)
End Function

Comment adapter les dimensions d'un UserForm à la taille de l'écran ?
auteur : SilkyRoad
Vba

Private Sub UserForm_Activate()
    With Me
        .StartUpPosition = 3
        .Width = Application.Width
        .Height = Application.Height
        .Left = 0
        .Top = 0
    End With
End Sub

Comment afficher une image PNG dans un UserForm ?
auteur : SilkyRoad
Le contrôle Image ne permet pas d'afficher le type de fichier PNG.
Une solution consiste à visualiser l'image dans un contrôle WebBrowser.

Vba

Private Sub UserForm_Initialize()
    Dim S As String
    Dim Hauteur As Long, Largeur As Long
    
    Hauteur = WebBrowser1.Height
    Largeur = WebBrowser1.Width
    S = "C:\Dossier\LeChat.png"
    
    WebBrowser1.Navigate _
        "ABOUT:<HTML><HEAD><body><IMG WIDTH=" & Largeur & " HEIGHT=" & Hauteur & _
        " SRC='" & S & "'</IMG></BODY></HTML>"
End Sub

Comment ajouter un bouton de réduction dans les UserForms ?
auteur : SilkyRoad
En utilisant la procédure suivante, un bouton de réduction est ajouté à côté de la croix de fermeture.
L'UserForm se réduira, en bas et à gauche de l'écran, lorsque vous cliquerez dessus.


Placez cette première macro dans un module standard. Vous utiliserez cette macro pour lancer l'UserForm.

Vba

Option Explicit
 
Sub LanceUSF()
    UserForm1.Show 0
End Sub


Ensuite, placez ce code dans le module objet du UserForm:

Vba

Option Explicit
 
Private Declare Function FindWindowA& Lib "User32" _
    (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function EnableWindow& Lib "User32" _
    (ByVal hWnd&, ByVal bEnable&)
Private Declare Function GetWindowLongA& Lib "User32" _
    (ByVal hWnd&, ByVal nIndex&)
Private Declare Function SetWindowLongA& Lib "User32" _
    (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)
 
 
Private Sub UserForm_Initialize()
    Dim hWnd As Long
    
    hWnd = FindWindowA(vbNullString, Me.Caption)
    SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) Or &H20000
End Sub
 
 
Private Sub UserForm_Activate()
    Dim hWnd As Long
    
    hWnd = FindWindowA("XLMAIN", Application.Caption)
    EnableWindow hWnd, 1
End Sub

Comment appliquer une transparence dans un UserForm ?
auteur : Starec
Cet exemple permet de paramétrer un niveau de transparence (de 0 à 100%) dans un UserForm.

Téléchargez le classeur démo.



Comment créer plusieurs instances d'un UserForm ?
auteur : Microsoft
Utilisez le mot clé New pour créer plusieurs instances d'une classe particulière. Votre UserForm peut ainsi être dupliqué plusieurs fois à l'écran.
Cet exemple est une traduction de l'article Microsoft.

Vba

'--- Dans un module standard --------
Option Explicit
Option Base 1

'Compte les instances d'UserForms.
Public mycount As Integer
'Tableau contenant les objets UserForm.
Public MyForms() As UserForm1


Sub New_UserForms()
    'Affiche l'UserForm.
    UserForm1.Show
End Sub
'-----------------------------------
Vba

'--- Dans un UserForm nommé UserForm1 -------
    
    'La forme doit contenir 3 CommandButton nommés:
        'cmdNewForm (caption = Nouveau)
        'cmdFormCaption  (caption = Affiche la propriété caption du UserForm)
        'cmdClose (caption = fermeture)
    'Une ListBox nommée:
        'ListBox1
        
Option Explicit


Private Sub cmdNewForm_Click()
    mycount = mycount + 1
    
    'Redéfinit la taille du tableau e , incrémentant d'une unité.
    ReDim Preserve MyForms(mycount)
    
    'Crée une nouvelle instance UserForm1.
    Set MyForms(mycount) = New UserForm1
    
    'Ajoute le numéro d'instance à la propriété 'Caption' du UserForm.
    MyForms(mycount).Caption = "instance " & mycount
    
    MyForms(mycount).cmdClose.Caption = "Masquer la forme"
    
    'Ajoute un élément dans la ListBox.
    UserForm1.ListBox1.AddItem mycount
End Sub


Private Sub cmdFormCaption_click()
    'Affiche la propriété 'Caption' du UserForm actif.
    MsgBox Me.Caption
End Sub


Private Sub cmdClose_Click()
    'Masque l'instance active.
    Me.Hide
End Sub


Private Sub ListBox1_MouseUp _
    (ByVal Button As Integer, ByVal Shift As Integer, _
    ByVal X As Single, ByVal Y As Single)
    'Affiche l'instance sélectionnée.
    MyForms(UserForm1.ListBox1.ListIndex + 1).Show

End Sub
      
      
Private Sub UserForm_QueryClose _
    (Cancel As Integer, CloseMode As Integer)
    
    'Gère l'absence de UserForm
     On Error Resume Next
    
     'Indiquez n'importe quelle valeur (Integer) autre que 0 pour désactiver
     'l'utilisation de la croix de fermeture ("X") du UserForm.
     Cancel = 1

End Sub

Est-il possible d'afficher une barre d'outils dans un UserForm ?
auteur : SilkyRoad
Cet exemple suppose que l'UserForm contient un label nommé Label1. La barre d'outils s'affiche lorsque vous cliquez sur ce label.

Vba

Option Explicit
 
Dim X As Single
Dim Y As Single
 
 
'Création de la barre d'outils lors du lancement du UserForm
Private Sub UserForm_Initialize()
    Dim Barre As CommandBar
    
    Set Barre = CommandBars.Add("MenuUSF", msoBarPopup, False, True)
    
    With Barre.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "Menu 01"
        .FaceId = 50
        'La procédure va appeler une macro nommée "Macro1", lorsque vous cliquerez
        'sur le bouton.
        .OnAction = "Macro1"
    End With
    
    With Barre.Controls.Add(msoControlButton, 2, , , True)
        .Caption = "Menu 02"
        .FaceId = 49
        'La procédure va appeler une macro nommée "Macro2", lorsque vous cliquerez
        'sur le bouton.
        .OnAction = "Macro2"
    End With
    
    
    With Me
        X = (.Width - .InsideWidth) / 2 + 8
        Y = .Height - .InsideHeight - X + 24
    End With
End Sub
 
 
 
'Affiche la barre d'outils lorsque vous cliquez sur le label.
Private Sub Label1_Click()
    Dim PosX As Single, PosY As Single
    
    PosX = (Me.Left + X + Label1.Left) * 4 / 3
    PosY = (Me.Top + Y + Label1.Top) * 4 / 3
    
    Application.CommandBars("MenuUSF").ShowPopup PosX, PosY
End Sub
 
 
 
'Supprime la barre d'outils lors de la fermeture du UserForm
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    On Error Resume Next
    CommandBars("MenuUSF").Delete
End Sub


Ajoutez ces deux macros dans un module standard:

Vba

Option Explicit

Sub Macro1()
    MsgBox "Essai 01"
End Sub


Sub Macro2()
    MsgBox "Essai 02"
End Sub

Comment ajouter un icône dans la barre de Caption ?
auteur : SilkyRoad
L'icône va s'afficher dans l'angle supérieur gauche de la forme.

Vba

Option Explicit
 
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
      (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
Private Declare Function SendMessageA Lib "user32" _
      (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, _
      ByVal lParam As Long) As Long
 
Private Declare Function ExtractIconA Lib "shell32.dll" _
      (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
 
 
 
Private Sub UserForm_Initialize()
    Dim Fichier As String
    Dim x As Long
    
    'Chemin et nom du fichier icône à afficher
    Fichier = "C:\Documents and Settings\mimi\dossier\bouton.ICO"
    'Vérifie si le fichier existe
    If Dir(Fichier) = "" Then Exit Sub
    
    x = ExtractIconA(0, Fichier, 0)
    SendMessageA FindWindow(vbNullString, Me.Caption), &H80, False, x
End Sub

A quoi sert l'évènement UserForm_Layout ?
auteur : SilkyRoad
L'évènement Layout est déclenché lorsque vous changez la position du UserForm.

Cet exemple définit la position de la boîte de dialogue et empêche de le déplacer à l'écran.

Vba

Private Sub UserForm_Layout()
    Application.ScreenUpdating = False
    'Définit la position horizontale de l'USF
    Me.Left = 200
    'Définit la position verticale de l'USF
    Me.Top = 50
    Application.ScreenUpdating = True
End Sub

precedent    sommaire    suivant   

Consultez les autres F.A.Q's


Les sources présentés sur cette pages sont libre de droits, et vous pouvez les utiliser à votre convenance. Par contre cette page de présentation de ces sources constitue une oeuvre intellectuelle protégée par les droits d'auteurs. Copyright ©2008  Developpez LLC. Tout droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à 3 ans de prison et jusqu'à 300 000 E de dommages et intérets. Cette page est déposée à la SACD.

Vos questions techniques : forum d'entraide Accueil - Publiez vos articles, tutoriels, cours et rejoignez-nous dans l'équipe de rédaction du club d'entraide des développeurs francophones. Nous contacter - Copyright 2000..2005 www.developpez.com