OVH Cloud OVH Cloud

Execution differente de code VBA sous W2K et XP

3 réponses
Avatar
Sébastien
J ai un petit soucis , j ai un usf que je dimensionne le plein ecran et je
souhaite qu il ne puisse pas etre deplace.
Voici le code que j ai mis pour cela :

Code:


Private Sub UserForm_Activate()
Dim hWnd As Long, exLong As Long
hWnd = FindWindowA(vbNullString, Me.Caption)
exLong = GetWindowLongA(hWnd, -16)
If exLong And &H880000 Then
SetWindowLongA hWnd, -16, exLong And &HFF77FFFF
Me.Hide: Me.Show
End If
End Sub




Cela fonctionne trés bien lorsque execute sous windows 2000, par contre
lorsque c est execute sous XP, l usf est bien en plein ecran mais il manque
la barre de titre de l usf

Pourquoi le code a des effets differents suivant l OS?
Comment y remedier?

Merci d avance

Sébastien

3 réponses

Avatar
Jacques93
Bonjour Sébastien,

Si je comprends ton code, dans le cas où ton UserForm à les bits de
style :

WS_SYSMENU = &H80000
et
WS_BORDER = &H800000

positionnés, tu les désactives. Effectivement sous W2K on a la barre de
titre, sans le menu système (ni la croix de fermeture), et sous XP on a
pas la barre de titre.

Hypothèse : le bit WS_SYSMENU ne s'applique qu'aux fenêtres qui ont une
barre de titre, XP fait peut être le trajet inverse, pas de menu système
donc pas de barre de titre ?

WS_SYSMENU Creates a window that has a Control-menu box in its
title bar. Used only for windows with title bars.

Extrait de :

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vclib/html/_mfc_window_styles.asp


Dans les deux cas (W2K et XP), je crois que tu as des fenêtres un peu
'instables', car je n'ai vu nulle part que ces bits empechaient de
déplacer un fenêtre (ce qui est pourtant le cas sous W2K). Mystère ...


J ai un petit soucis , j ai un usf que je dimensionne le plein ecran et je
souhaite qu il ne puisse pas etre deplace.
Voici le code que j ai mis pour cela :

Code:


Private Sub UserForm_Activate()
Dim hWnd As Long, exLong As Long
hWnd = FindWindowA(vbNullString, Me.Caption)
exLong = GetWindowLongA(hWnd, -16)
If exLong And &H880000 Then
SetWindowLongA hWnd, -16, exLong And &HFF77FFFF
Me.Hide: Me.Show
End If
End Sub




Cela fonctionne trés bien lorsque execute sous windows 2000, par contre
lorsque c est execute sous XP, l usf est bien en plein ecran mais il manque
la barre de titre de l usf

Pourquoi le code a des effets differents suivant l OS?
Comment y remedier?

Merci d avance

Sébastien



--
Cordialement,

Jacques.

Avatar
Sébastien
Bonsoir Jacques

Merci de ta réponse, j'ai trouvé ce code sur internet.
Je comprend dans ton message que ce n'est pas la méthode la plus
approprié(instable).
Comment faire autrement??

Merci d'avance

Sébastien
Avatar
Jacques93
Bonsoir Sébastien,

Si le but est d'empecher le déplacement de la fenêtre, modifier le
menu système de la fenêtre. Le code suivant désactive le déplacement et
la fermeture qui sont les choix disponibles pour un UserForm :

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

Private Declare Function ModifyMenu _
Lib "user32" _
Alias "ModifyMenuA" ( _
ByVal hMenu As Long, _
ByVal nPosition As Long, _
ByVal wFlags As Long, _
ByVal wIDNewItem As Long, _
ByVal lpString As String) As Long

Private Declare Function GetSystemMenu _
Lib "user32" ( _
ByVal hWnd As Long, _
ByVal bRevert As Long) As Long

Private Declare Function DrawMenuBar _
Lib "user32" (ByVal hWnd As Long) As Long


Private Const MF_BYCOMMAND As Long = &H0
Private Const MF_GRAYED As Long = &H1
Private Const SC_MOVE As Long = &HF010&
Private Const SC_CLOSE As Long = &HF060&


Private Sub UserForm_Activate()
Dim hWnd As Long

hWnd = FindWindow(vbNullString, Me.Caption)

' Désactive la croix de fermeture
Call ModifyMenu( _
GetSystemMenu(hWnd, 0), _
SC_CLOSE, _
MF_BYCOMMAND Or MF_GRAYED, _
0, "Fermeture")

' Désactive le déplacement
Call ModifyMenu( _
GetSystemMenu(hWnd, 0), _
SC_MOVE, _
MF_BYCOMMAND Or MF_GRAYED _
0, "Déplacer")
DrawMenuBar hWnd
End Sub

' Bouton de sortie de secours :-D
Private Sub CommandButton1_Click()
Unload Me
End Sub


Bonsoir Jacques

Merci de ta réponse, j'ai trouvé ce code sur internet.
Je comprend dans ton message que ce n'est pas la méthode la plus
approprié(instable).
Comment faire autrement??

Merci d'avance

Sébastien



--
Cordialement,

Jacques.