| 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
|
|
| 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
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 ()
AfficheTitleBarre Me. Caption , False
End Sub
|
|
| 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
|
|
| 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
|
|
| 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
|
|
| 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
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
. OnAction = " Macro1 "
End With
With Barre. Controls . Add (msoControlButton, 2 , , , True )
. Caption = " Menu 02 "
. FaceId = 49
. OnAction = " Macro2 "
End With
With Me
X = (. Width - . InsideWidth ) / 2 + 8
Y = . Height - . InsideHeight - X + 24
End With
End Sub
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
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
|
|
| 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
Fichier = " C:\Documents and Settings\mimi\dossier\bouton.ICO "
If Dir (Fichier) = " " Then Exit Sub
x = ExtractIconA (0 , Fichier, 0 )
SendMessageA FindWindow (vbNullString , Me. Caption ), & H80, False , x
End Sub
|
|
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.
|