vba : ne pas permettre de bouger un usf

[miguelangelo]

Bonjour à tous,

je l'ai cherché, je le cherche toujours, le truc à cliquer ou à informer dans les propriétés de l'usf pour ne pas permettre de le déplacer.

Avec votre aide je pense que je mettrai moins de temps à chercher..

PS : sous excel 2000.

Merci à vous

 

[Pierrot93]

Re : vba : ne pas permettre de bouger un usf

Bonjour,

regarde le code ci-dessous, à placer dans le module de l'usf...

Option Explicit
Dim mTop As Single, mLeft As Single
Private Sub UserForm_Activate()
    mTop = Me.Top
    mLeft = Me.Left
End Sub
Private Sub UserForm_Layout()
Application.ScreenUpdating = False
    If mTop <> 0 Then
        Me.Top = mTop
        Me.Left = mLeft
    End If
Application.ScreenUpdating = True
End Sub

bon après midi
@+

 

[miguelangelo]

Re : vba : ne pas permettre de bouger un usf

ah qd meme !!
je pensais juste un truc à cocher qq part !!

merci bcp Pierrot

 

[Pierrot93]

Re : vba : ne pas permettre de bouger un usf

Re,

non, pas de propriété pour empêcher le déplacement...
@+

 

[Ashaar]

Re : vba : ne pas permettre de bouger un usf

Une autre solution (à placer dans le code lié au Userform) :
On utilisera les fonctionnalité de windows.


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

Private Declare Function GetWindowLongA Lib "User32" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare Function SetWindowLongA Lib "User32" _
(ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long


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

 

[miguelangelo]

Re : vba : ne pas permettre de bouger un usf

merci a toi ashaar....

 

[YANN-56]

Re : vba : ne pas permettre de bouger un usf

Bonjour à tous,

Tu peux aussi cacher carrément la "Bande Bleue"

Mais attention de ne pas oublier de créer un bouton avec "Unload Me"

Dans un Module:

Declare Function GetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long

Sub CACHER_BANDE_BLEUE(USF As UserForm)
Dim hWnd&
hWnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", "X", "D") & "Frame", USF.Caption)
SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) And Not &HC00000: DrawMenuBar hWnd
End Sub

Dans l'USF:

Private Sub UserForm_Initialize()
CACHER_BANDE_BLEUE Me
End Sub

A voir

Amicalement

 

[miguelangelo]

Re : vba : ne pas permettre de bouger un usf

j'y ai pas pensé, mais c excellent !!!
merci yann