vba : ne pas permettre de bouger un usf

miguelangelo

XLDnaute Occasionnel
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

XLDnaute Barbatruc
Re : vba : ne pas permettre de bouger un usf

Bonjour,

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

Code:
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
@+
 

Ashaar

XLDnaute Junior
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
 

YANN-56

XLDnaute Barbatruc
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:

Code:
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:

Code:
Private Sub UserForm_Initialize()
CACHER_BANDE_BLEUE Me
End Sub

A voir

Amicalement
 

Discussions similaires

Statistiques des forums

Discussions
312 836
Messages
2 092 639
Membres
105 475
dernier inscrit
ramzi slama