Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Développement Développement Visual Basic BOUTONS FENETRES DANS VISUAL BASIC POUR APPLICATION

BOUTONS FENETRES DANS VISUAL BASIC POUR APPLICATION

8 réponses
Avatar
Stéphane.b
Comment créer une fenetre de types USERFORM dans visual basic pour
application avec les trois boutons en haut à droite?

Je peut créer une fentre mais uniquement avec une croix de fermeture mais
pas de boutons d'iconisation ou de réduction.

Merci pour votre aide.

Stéphane B.
Signaler un problème avec ce contenu

8 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
parci
On Fri, 21 Dec 2007 12:14:02 -0800, Stéphane.b
wrote:

Comment créer une fenetre de types USERFORM dans visual basic pour
application avec les trois boutons en haut à droite?

Je peut créer une fentre mais uniquement avec une croix de fermeture mais
pas de boutons d'iconisation ou de réduction.




Dans un module standard :

' Window field offsets for GetWindowLong() and GetWindowWord()
Private Const GWL_STYLE = (-16)

' Window Styles
Private Const WS_OVERLAPPED = &H0&
Private Const WS_POPUP = &H80000000
Private Const WS_CHILD = &H40000000
Private Const WS_MINIMIZE = &H20000000
Private Const WS_VISIBLE = &H10000000
Private Const WS_DISABLED = &H8000000
Private Const WS_CLIPSIBLINGS = &H4000000
Private Const WS_CLIPCHILDREN = &H2000000
Private Const WS_MAXIMIZE = &H1000000
Private Const WS_CAPTION = &HC00000
Private Const WS_BORDER = &H800000
Private Const WS_DLGFRAME = &H400000
Private Const WS_VSCROLL = &H200000
Private Const WS_HSCROLL = &H100000
Private Const WS_SYSMENU = &H80000
Private Const WS_THICKFRAME = &H40000
Private Const WS_GROUP = &H20000
Private Const WS_TABSTOP = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_MAXIMIZEBOX = &H10000

' SetWindowPos Flags
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOREDRAW = &H8
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_FRAMECHANGED = &H20 ' The frame changed:
send WM_NCCALCSIZE
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_NOCOPYBITS = &H100
Private Const SWP_NOOWNERZORDER = &H200 ' Don't do owner Z
ordering

Private Declare Function SetWindowLong Lib "user32" Alias
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal
lNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias
"GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private 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
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

' donner le menu system complet à un UserForm
Public Function UserFormWithSystemMenu(uf As UserForm) As Long

Dim lStyle As Long
Dim hWnd As Long
Dim dwBits As Long
Dim sCaption As String

sCaption = uf.Caption
dwBits = WS_SYSMENU Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
hWnd = FindWindow("ThunderXFrame", sCaption)

If hWnd <> 0 Then
lStyle = GetWindowLong(hWnd, GWL_STYLE)
lStyle = (lStyle Or dwBits)
SetWindowLong hWnd, GWL_STYLE, lStyle
SetWindowPos hWnd, 0, 0, 0, 0, 0, _
SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOZORDER Or _
SWP_NOOWNERZORDER Or SWP_FRAMECHANGED
End If

End Function



Appel depuis un UserForm :

Private Sub UserForm_Initialize()
UserFormWithSystemMenu Me
End Sub

Si tu veux en plus que ton formulaire soit "redimensionable", tu peux
lui donner le style WS_THICKFRAME et donc modifier la ligne :
dwBits = WS_SYSMENU Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
par
dwBits = WS_SYSMENU Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or
WS_THICKFRAME
Avatar
Stéphane.b
Pour parci

J'ai essayé ta méthode mais cela ne marche pas.

Comment proceder car je suis débutant et j'aimerai plus d'explications
c'est à dire étape par étape.

J'ai mis d'abord la première partie du code avec les fonctions dans un
module standart ( non de class)
ensuite j'ai créer un Userform ou j'ai mis le code de fin ( Initialize ).

J'ai un message erreur avec l'instruction Send WM_NCCALCSIZE

Merci pour l'aide.

Stéphane B.



"parci" a écrit :

On Fri, 21 Dec 2007 12:14:02 -0800, Stéphane.b
wrote:

>Comment créer une fenetre de types USERFORM dans visual basic pour
>application avec les trois boutons en haut à droite?
>
>Je peut créer une fentre mais uniquement avec une croix de fermeture mais
>pas de boutons d'iconisation ou de réduction.
>

Dans un module standard :

' Window field offsets for GetWindowLong() and GetWindowWord()
Private Const GWL_STYLE = (-16)

' Window Styles
Private Const WS_OVERLAPPED = &H0&
Private Const WS_POPUP = &H80000000
Private Const WS_CHILD = &H40000000
Private Const WS_MINIMIZE = &H20000000
Private Const WS_VISIBLE = &H10000000
Private Const WS_DISABLED = &H8000000
Private Const WS_CLIPSIBLINGS = &H4000000
Private Const WS_CLIPCHILDREN = &H2000000
Private Const WS_MAXIMIZE = &H1000000
Private Const WS_CAPTION = &HC00000
Private Const WS_BORDER = &H800000
Private Const WS_DLGFRAME = &H400000
Private Const WS_VSCROLL = &H200000
Private Const WS_HSCROLL = &H100000
Private Const WS_SYSMENU = &H80000
Private Const WS_THICKFRAME = &H40000
Private Const WS_GROUP = &H20000
Private Const WS_TABSTOP = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_MAXIMIZEBOX = &H10000

' SetWindowPos Flags
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOREDRAW = &H8
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_FRAMECHANGED = &H20 ' The frame changed:
send WM_NCCALCSIZE
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_NOCOPYBITS = &H100
Private Const SWP_NOOWNERZORDER = &H200 ' Don't do owner Z
ordering

Private Declare Function SetWindowLong Lib "user32" Alias
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal
lNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias
"GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private 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
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

' donner le menu system complet à un UserForm
Public Function UserFormWithSystemMenu(uf As UserForm) As Long

Dim lStyle As Long
Dim hWnd As Long
Dim dwBits As Long
Dim sCaption As String

sCaption = uf.Caption
dwBits = WS_SYSMENU Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
hWnd = FindWindow("ThunderXFrame", sCaption)

If hWnd <> 0 Then
lStyle = GetWindowLong(hWnd, GWL_STYLE)
lStyle = (lStyle Or dwBits)
SetWindowLong hWnd, GWL_STYLE, lStyle
SetWindowPos hWnd, 0, 0, 0, 0, 0, _
SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOZORDER Or _
SWP_NOOWNERZORDER Or SWP_FRAMECHANGED
End If

End Function



Appel depuis un UserForm :

Private Sub UserForm_Initialize()
UserFormWithSystemMenu Me
End Sub

Si tu veux en plus que ton formulaire soit "redimensionable", tu peux
lui donner le style WS_THICKFRAME et donc modifier la ligne :
dwBits = WS_SYSMENU Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
par
dwBits = WS_SYSMENU Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or
WS_THICKFRAME




Avatar
Jacques93
Bonjour Stéphane.b
Stéphane.b a écrit :
Pour parci

J'ai essayé ta méthode mais cela ne marche pas.

Comment proceder car je suis débutant et j'aimerai plus d'explications
c'est à dire étape par étape.

J'ai mis d'abord la première partie du code avec les fonctions dans un
module standart ( non de class)



Pas gênant

ensuite j'ai créer un Userform ou j'ai mis le code de fin ( Initialize ).

J'ai un message erreur avec l'instruction Send WM_NCCALCSIZE




[...]

Private Const SWP_FRAMECHANGED = &H20 ' The frame changed:
send WM_NCCALCSIZE





c'est la suite du commentaire, pas une instruction. La ligne a été
coupée par le logiciel de news.

Private Const SWP_SHOWWINDOW = &H40





[...]


' donner le menu system complet à un UserForm
Public Function UserFormWithSystemMenu(uf As UserForm) As Long

Dim lStyle As Long
Dim hWnd As Long
Dim dwBits As Long
Dim sCaption As String

sCaption = uf.Caption
dwBits = WS_SYSMENU Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
hWnd = FindWindow("ThunderXFrame", sCaption)





sous Excel 2003 et 2007, la classe des fenêtres de type UserForm est :

"ThunderDFrame"

ce nom peut varier avec les versions (d'excel), laquelle utilises tu ?

If hWnd <> 0 Then
lStyle = GetWindowLong(hWnd, GWL_STYLE)
lStyle = (lStyle Or dwBits)
SetWindowLong hWnd, GWL_STYLE, lStyle
SetWindowPos hWnd, 0, 0, 0, 0, 0, _
SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOZORDER Or _
SWP_NOOWNERZORDER Or SWP_FRAMECHANGED
End If

End Function



Appel depuis un UserForm :

Private Sub UserForm_Initialize()
UserFormWithSystemMenu Me
End Sub






J'appellerai la fonction plutôt à partir de l'événement Activate, dans
Initialize l'UserForm n'est pas encore visible, pas sûr que ça ne puisse
pas interférer.

--
Meilleurs voeux à tous,

Jacques.
Avatar
parci
On Sun, 23 Dec 2007 08:27:00 -0800, Stéphane.b
wrote:

Pour parci

J'ai essayé ta méthode mais cela ne marche pas.



Si, si, ça fonctionne mais certaines lignes étaient tronquées un peu
court.

Comment proceder car je suis débutant et j'aimerai plus d'explications
c'est à dire étape par étape.



Pour les UserForm, le menu system de fenêtre est incomplet et il n'y a
pas de propriétés en standard permettant de le modifier. Il faut donc
le faire soit même en modifiant le style de fenêtre via des fonctions
de l'API Windows.

On peut retrouver le style avec GetWindowLong sous forme d'un entier
long (c'est la combinaison des bits de cet entier qui détermine en
réalité le style). Il faut ensuite modifier les bits souhaités et
redéfinir le nouveau style pour la fenêtre avec SetWindowLong. Il faut
ensuite demander au system de redessiner la fenêtre pour que les
modifications soient effectives ce que peut faire SetWindowPos. Le
problème étant que toutes ces fonctions de l'API demande un handle de
fenêtre (un identifiant) comme paramètre, or pour les UserForms il n'y
a pas non plus de propriété retournant ce handle : d'où l'appel à
FindWindow pour retrouver d'abord le handle de l'UserForm passé en
paramètre.

Toutes ces fonctions doivent être déclarées avant de pouvoir être
utilisées en VBA. Ces fonctions sont aussi documentées dans MSDN :
c'est là qu'il faudra regarder quels paramètres utiliser pour quel
résultat.

Quand on débute, je pense qu'il vaudrait mieux se limiter aux
fonctionnalités natives du langage et donc ne pas faire ce genre de
chose. Je ne sais pas quel est ton besoin, mais je me doute bien que
si tu implémentes un menu system complet pour les UserForms tu vas
devoir ensuite repositionner/redimensioner les contrôles en fonction
de la taille du formulaire, et là non plus, rien n'est prévu en
standard pour que ce soit automatique ...


' dans un module standard
' Window field offsets for GetWindowLong()
Private Const GWL_STYLE = (-16)

' Window Styles
Private Const WS_OVERLAPPED = &H0&
Private Const WS_POPUP = &H80000000
Private Const WS_CHILD = &H40000000
Private Const WS_MINIMIZE = &H20000000
Private Const WS_VISIBLE = &H10000000
Private Const WS_DISABLED = &H8000000
Private Const WS_CLIPSIBLINGS = &H4000000
Private Const WS_CLIPCHILDREN = &H2000000
Private Const WS_MAXIMIZE = &H1000000
Private Const WS_CAPTION = &HC00000
Private Const WS_BORDER = &H800000
Private Const WS_DLGFRAME = &H400000
Private Const WS_VSCROLL = &H200000
Private Const WS_HSCROLL = &H100000
Private Const WS_SYSMENU = &H80000
Private Const WS_THICKFRAME = &H40000
Private Const WS_GROUP = &H20000
Private Const WS_TABSTOP = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_MAXIMIZEBOX = &H10000

' SetWindowPos Flags
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOREDRAW = &H8
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_FRAMECHANGED = &H20
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_NOCOPYBITS = &H100
Private Const SWP_NOOWNERZORDER = &H200

Private Declare Function SetWindowLong _
Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal lNewLong As Long) As Long

Private Declare Function GetWindowLong _
Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long

Private 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

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


' donner le menu system complet à un UserForm
Public Function UserFormWithSystemMenu(uf As UserForm) As Long

Dim lStyle As Long
Dim hWnd As Long
Dim dwBits As Long
Dim sCaption As String

sCaption = uf.Caption
dwBits = WS_SYSMENU Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX

' formulaire "redimensionable" graphiquement
' dwBits = WS_SYSMENU Or WS_MINIMIZEBOX Or _
' WS_MAXIMIZEBOX Or WS_THICKFRAME

hWnd = FindWindow("ThunderXFrame", sCaption)

If hWnd <> 0 Then
lStyle = GetWindowLong(hWnd, GWL_STYLE)
lStyle = (lStyle Or dwBits)
SetWindowLong hWnd, GWL_STYLE, lStyle
SetWindowPos hWnd, 0, 0, 0, 0, 0, _
SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOZORDER Or _
SWP_NOOWNERZORDER Or SWP_FRAMECHANGED
End If

End Function


' appel depuis un UserForm :
Private Sub UserForm_Initialize()
UserFormWithSystemMenu Me
End Sub
Avatar
parci
On Thu, 27 Dec 2007 16:05:19 +0100, Jacques93 wrote:

hWnd = FindWindow("ThunderXFrame", sCaption)





sous Excel 2003 et 2007, la classe des fenêtres de type UserForm est :

"ThunderDFrame"

ce nom peut varier avec les versions (d'excel), laquelle utilises tu ?



Tu fais bien de le préciser, effectivement. Est-ce que les UserForms
ont des propriétés différentes à partir d'Office 2003 ?

Private Sub UserForm_Initialize()
UserFormWithSystemMenu Me
End Sub






J'appellerai la fonction plutôt à partir de l'événement Activate, dans
Initialize l'UserForm n'est pas encore visible, pas sûr que ça ne puisse
pas interférer.



Personnellement, tout ce qui ressemble à une initialisation, je
l'appelle depuis Initialize. Ca marche aussi depuis Activate, mais il
y aura un appel à chaque fois que le formulaire va être activé.
Avatar
Jacques93
Bonjour parci,
parci a écrit :
On Thu, 27 Dec 2007 16:05:19 +0100, Jacques93 wrote:

hWnd = FindWindow("ThunderXFrame", sCaption)




sous Excel 2003 et 2007, la classe des fenêtres de type UserForm est :

"ThunderDFrame"

ce nom peut varier avec les versions (d'excel), laquelle utilises tu ?



Tu fais bien de le préciser, effectivement. Est-ce que les UserForms
ont des propriétés différentes à partir d'Office 2003 ?



Justement, j'étais en train de chercher depuis quand cette modification,
me disant que tu ne n'avais pas indiqué ThunderXFrame par hasard, dont
la dénomination semble logique X => eXcel. Il semblerait que ce soit
depuis Office 2000 :

<http://www.tek-tips.com/faqs.cfm?fidQ96>

Par ailleurs cette classe (ThunderDFrame) est également utilisé par Word
et je suppose les autres applications Office depuis la version 2000.
Peux tu confirmer, par rapport aux versions auxquelles tu as accès ?

Private Sub UserForm_Initialize()
UserFormWithSystemMenu Me
End Sub





J'appellerai la fonction plutôt à partir de l'événement Activate, dans
Initialize l'UserForm n'est pas encore visible, pas sûr que ça ne puisse
pas interférer.



Personnellement, tout ce qui ressemble à une initialisation, je
l'appelle depuis Initialize. Ca marche aussi depuis Activate, mais il
y aura un appel à chaque fois que le formulaire va être activé.



Ben là j'ai une bizarrerie avec la caption du UserForm. Elle est vide en
l'appelant de l'un ou l'autre des événements. A voir ...

--
Meilleurs voeux à tous,

Jacques.
Avatar
parci
On Thu, 27 Dec 2007 20:05:10 +0100, Jacques93 wrote:

Justement, j'étais en train de chercher depuis quand cette modification,
me disant que tu ne n'avais pas indiqué ThunderXFrame par hasard, dont
la dénomination semble logique X => eXcel. Il semblerait que ce soit
depuis Office 2000 :

<http://www.tek-tips.com/faqs.cfm?fidQ96>

Par ailleurs cette classe (ThunderDFrame) est également utilisé par Word
et je suppose les autres applications Office depuis la version 2000.
Peux tu confirmer, par rapport aux versions auxquelles tu as accès ?



Pour Office 97 et 2000 (Excel et Word au moins), la classe des
UserForm est "ThunderXFrame". Je ne pense pas que le X soit
spécifique à Excel. Le genre de changement un peu pénible ...

Private Sub UserForm_Initialize()
UserFormWithSystemMenu Me
End Sub





J'appellerai la fonction plutôt à partir de l'événement Activate, dans
Initialize l'UserForm n'est pas encore visible, pas sûr que ça ne puisse
pas interférer.



Personnellement, tout ce qui ressemble à une initialisation, je
l'appelle depuis Initialize. Ca marche aussi depuis Activate, mais il
y aura un appel à chaque fois que le formulaire va être activé.



Ben là j'ai une bizarrerie avec la caption du UserForm. Elle est vide en
l'appelant de l'un ou l'autre des événements. A voir ...



Je n'ai qu'Office 97 ici, mais je ne vois pas le problème. On peut
toujours fixer la caption par code mais *avant* de modifier le menu
system, sinon le menu standard est restauré.

Private Sub UserForm_Initialize()
Me.Caption = "zaza"
UserFormWithSystemMenu Me
End Sub
Avatar
Jacques93
Bonjour parci,
parci a écrit :
On Thu, 27 Dec 2007 20:05:10 +0100, Jacques93 wrote:


[...]
Pour Office 97 et 2000 (Excel et Word au moins), la classe des
UserForm est "ThunderXFrame". Je ne pense pas que le X soit
spécifique à Excel. Le genre de changement un peu pénible ...



Effectivement, ma supposition était erronée, la classe des fenêtres
UserForm est commune à Word, Excel, PowerPoint, etc ...

Après vérification, pour Office 97, le nom de classe des UserForm est :

ThunderXFrame

Et à partir de Office 2000, et donc pour 2002 (Office XP), 2003 et 2007 :

ThunderDFrame

On peut tester (ici sous Excel), la version afin de faire le bon test :

If Application.Version < 9 ' Excel 97
hWnd = FindWindow("ThunderXFrame", sCaption)
Else ' Excel >= 2000
hWnd = FindWindow("ThunderDFrame", sCaption)
End If

--
Cordialement,

Jacques.