Inhiber le déplacement d'un UserForm que le ScreenUpdating est à False

Version imprimable

05/11/2010, 23h08
Touffe54

Inhiber le déplacement d'un UserForm que le ScreenUpdating est à False

Bonsoir,

Comment peut on empêcher de déplacer un UserForm, quand on a désactivé le ScreenUpdating.

J'ai trouvé une solution dans la F.A.Q. avec l'évènement layout, mais le résultat n'est pas concluant : on peut toujours bouger la fenêtre, l'évènement layout intervenant une fois qu'on a laché le bouton de la souris.

Merci de m'éclairer.
05/11/2010, 23h26
ESVBA

Bonsoir Touffe54, le forum

la seule que je connaisse est de supprimer le titre de la fenêtre par API Windows (Voir la FAQ) et de la remplacer par une étiquette.

ESVBA

salut

pas sûr d'avoir bien compris ce que tu veux faire et pourquoi tu veux le faire.

Si c'est ceci : "empêcher le déplacement quand screenupdating = False et l'autoriser quand = True ", voilà, parmi d'autres, une manière ===>>>

1) tout en haut (dans la partie générale) du module de code de ton userform :
Code:

1 2 3 4 5 Option Explicit Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
2) immédiatement après chaque instruction ScreenUpdating = False :
Code:

1 2 3 Dim sysmen As Long sysmen = GetSystemMenu(FindWindowA(vbNullString, Me.Caption), 0) DeleteMenu sysmen, &HF010&, &H0&
2) immédiatement après chaque instruction ScreenUpdating = True:
Code:

1 2 GetSystemMenu FindWindowA(vbNullString, Me.Caption), True DrawMenuBar FindWindowA(vbNullString, Me.Caption)
Il sera d'ailleurs plus commode de mettre dans deux procédures (par exemple autoriser et inhiber) les deux codes et de lancer inhiber après un screenupdating à false et autoriser en le remettant à true ;)

06/11/2010, 18h01
Touffe54

J'ai pris note du code, mais pour l'instant çà bug.

Merci quand même.
06/11/2010, 18h05
babaothe

Citation:

Envoyé par Touffe54

J'ai pris note du code, mais pour l'instant çà bug.

Merci quand même.

montre donc ton code

heu

bonjour a tous les deux

je viens d'essayer le code de babahote un peu modifier pour aller dans un module standard

les deux actions s'appellent "enleve et remet"
et sa ne marche pas du tout ca ne fais absolument rien
y aurait t-il pas une erreur au niveau des variables "&HF010&, &H0"

les deux actions sont appelées par deux boutons

code dans le userform

Code:

1
2
3
4
5
6
7
8
 
Private Sub CommandButton1_Click()
enleve Me
End Sub
 
Private Sub CommandButton2_Click()
remet Me
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
 
Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Public Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public sysmen As Long
 
 
Sub enleve(maform As UserForm)
   sysmen = GetSystemMenu(FindWindowA(vbNullString, maform.Caption), 0)
    DeleteMenu sysmen, &HF010&, &H0&
  End Sub
 
Sub remet(maform As UserForm)
 GetSystemMenu FindWindowA(vbNullString, maform.Caption), False
    DrawMenuBar FindWindowA(vbNullString, maform.Caption)
 End Sub

salut patricktoulon

1) regarde et teste :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Option Explicit
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
Private Sub enleve_Click()
    Dim sysmen As Long
    sysmen = GetSystemMenu(FindWindowA(vbNullString, Me.Caption), 0)
    DeleteMenu sysmen, &HF010&, &H0&
End Sub
 
Private Sub remet_Click()
    GetSystemMenu FindWindowA(vbNullString, Me.Caption), True
    DrawMenuBar FindWindowA(vbNullString, Me.Caption)
End Sub

2) je te laisse découvrir seul ton erreur (elle n'est pas dan,s mon code, ni dans les constantes utilisées) :D

EDIT :
C'est long, hein ?....:(
Alors : un indice : tu utilises ici des fonctions de l'Api de WINDOWS et ni Excel ni VBA n'ont rien à voir là dedans...
Pas de déclic ?

rebonjour babahote
j'ai réésayé ton code dans le module de l'userform effectivement ca fonctionne
mis a part un false a la place d'un true oh!!!!!! mille excuses

a part ca c'est exactement la meme chose que j'ai deplacé dans un module
mais des que je transfert le tout dans un module standard ya plus rieeeeeeeeen qui marche ca me crée meme pas d'erreur
je rehitere a dire que ca ne fonctionne pas dans un module standard
pourtant la variable representant l'userform est bien reconnue

y aurait -il une explication a ca car moi je la voi pas
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 'Option Explicit Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long Public Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long Public Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public sysmen As Long Sub enlever(maform As UserForm) sysmen = GetSystemMenu(FindWindowA(vbNullString, maform.Caption), 0) DeleteMenu sysmen, &HF010&, &H0& End Sub Sub remetre(montruc As UserForm) GetSystemMenu FindWindowA(vbNullString, montruc.Caption), True DrawMenuBar FindWindowA(vbNullString, montruc.Caption) End Sub
hors ca devrait fonctionner pour moi

au plaisir

lis donc mon edit (si pas encore lu)... et oublie donc UserForm !

Regarde :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 
Option Explicit
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private monhwnd As Long
 
 
Private Sub commandbutton1_Click()
    enleve
End Sub
 
Private Sub commandbutton2_Click()
    remet
End Sub
 
Private Sub UserForm_Activate()
  monhwnd = FindWindowA(vbNullString, Me.Caption)
End Sub
 
Private Sub enleve()
    Dim sysmen As Long
    sysmen = GetSystemMenu(monhwnd, 0)
    DeleteMenu sysmen, &HF010&, &H0&
End Sub
Private Sub remet()
    GetSystemMenu monhwnd, True
    DrawMenuBar monhwnd
End Sub

Et ce n'est pas la seule manière :lol:
On peut jouer autrement, et encore autrement, et encore autrement ....

EDIT et PS : et je me suis piégé seul (je voulais laisser une part de réflexion et de travail au demandeur... et j'ai fini par lui servir un plat tout chaud !!!)

06/11/2010, 20h54
patricktoulon

re

dans ton dernier post tu passe le handle en variable a part ca tu n'a rien changé
c'est pas le probleme le souci c'est des que tu met ca dans un module standard ca ne fonctionne pas je suis sur l'aide en ligne et il semblerait que sa vienne des api en fin si tu a une version dans un module standard ca m'interresse je suis en train de faire un petit tuto sur les api avec la "user32.dll " et celle la de fonction je l'avais zapé (tres peu utilisée)

merci a toi

au plaisir

re,

mais où est donc la difficulté que je ne vois absolument pas ? (loa fatigue, sans doute ?)

Alors :
dans le module standard :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Option Explicit
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
'========================attention : maintenant ===>> Public
Public Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public monhwnd As Long
Public Sub enleve()
    Dim sysmen As Long
    sysmen = GetSystemMenu(monhwnd, 0)
    DeleteMenu sysmen, &HF010&, &H0&
End Sub
Public Sub remet()
    GetSystemMenu monhwnd, True
    DrawMenuBar monhwnd
End Sub

et sur le UserForm :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Option Explicit
 
Private Sub commandbutton1_Click()
    enleve
End Sub
 
Private Sub commandbutton2_Click()
    remet
End Sub
 
Private Sub UserForm_Activate()
  monhwnd = FindWindowA(vbNullString, Me.Caption)
End Sub

Que veux-tu d'autre ? Que je passe aussi le Me en paramètre ? (Rien de plus simple, bien que peu intéressant ... peu "enrichissant" puisque plus que classique !)

re

voila ma version sensiblement la meme

merci a toi pour me l'avoir rappeller celle la

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
Option Explicit
Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Public Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public monhwnd As Long
Public maform As Object
Public sysmen As Long
 Sub enleve()
  monhwnd = FindWindowA(vbNullString, maform.Caption)
 
 
   sysmen = GetSystemMenu(monhwnd, 0)
    DeleteMenu sysmen, &HF010&, &H0&
End Sub
 Sub remet()
    GetSystemMenu monhwnd, True
    DrawMenuBar monhwnd
End Sub

module userform

Code:

1
2
3
4
5
6
7
8
9
10
 
Private Sub enlever_Click()
enleve
End Sub
Private Sub remetre_Click()
remet
End Sub
Private Sub UserForm_Activate()
 Set maform = Me
End Sub

ce que j'ai voulu expliquer dans ce post c'est que avec la fonction "GetSystemMenu" ne marche pas si j'appelle la fonction en determinant "me" comme object des le depart hors avec d'autre api ca fonctionne parfaitement bien voila !!! et non je ne suis pas en rade hihihihi

au plaisir

Allez, tiens (et bien que je n'aime pas cette manière plus lourde) :
voilà tout en paramètre, y compris le Me :

dans ton userform :

Code:

1
2
3
4
5
6
7
8
9
Option Explicit
 
Private Sub commandbutton1_Click()
    enleve Me
End Sub
 
Private Sub commandbutton2_Click()
    remet Me
End Sub

et dans ton module standard :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Option Explicit
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Sub enleve(f As Object)
    Dim sysmen As Long
    sysmen = GetSystemMenu(FindWindowA(vbNullString, f.Caption), 0)
    DeleteMenu sysmen, &HF010&, &H0&
End Sub
Public Sub remet(f As Object)
    GetSystemMenu FindWindowA(vbNullString, f.Caption), True
    DrawMenuBar FindWindowA(vbNullString, f.Caption)
End Sub

note que maintenant toutes mes fonctions sont du coup en Private sauf, bien évidemment les fonctions Remet et Enleve.
Note également comment je passe l'userform en paramètre (on est avec l'Api de Windows...).
Bonne nuit.

06/11/2010, 21h57
patricktoulon

re

re

donc si je comprend bien si je declare les api en public elle ne fonctionnent pas hors avec d'autre ca marche tres bien dans les meme situation dailleur

si tu regarde mes contrib je parle souventn des userforms et je suis en public pratiquement tout le temp

c'est bizarre atu une explication car je n'en ai pas trouvé
en tout cas mise a part le "public " c'est exactement comme ca que je l'ai fait la premiere fois

au plaisir
06/11/2010, 22h04
patricktoulon

re

puré je vien de comprendre mais bon sang mais c'est bien sur

toi tu ecris
" enleve(f as object)"

moi j'avais ecris
"enleve(f as userform)"

sinon en public ca fonctionne hihihihihihi

je confirme donc qu'il semblerait que cet api soit un peu diferente des autres issues de la user32.dll car moi avec pratiquement toute j'ai toujour s utilisé "as userform"
je le signalerais dans mon tuto

je suis loin d'etre en rade hihihihi

au plaisir
07/11/2010, 07h08
babaothe

Citation:

Envoyé par patricktoulon

* puré je vien de comprendre
.....
.....

** sinon en public ca fonctionne hihihihihihi

¨¨¨¨¨¨

Enfin :lol:
Alors :
* ===>> j'ai pourtant à plusieurs reprises tenté de t'ouvrir les yeux ;)

** ===>> bien évidemment, que ça fonctionne ! Mais inutilement plus "cher".
Te viendrait-il à l'idée d'acheter pour 100 Kopecs ce que tu peux avoir pour 2 kopecs ? :lol:
ou de te rendre, avec un camion chargé de tous tes outils, sur un chantier où tu ne devras utiliser qu'un tournevis ?
ou d'adresser à tous les habitants de ton quartier une lettre qui ne doit être lue que par l'un d'entre eux ?
Non, n'est-ce-pas ? ===>> sois alors aussi économe en ce qui concerne l'espace de stockage en mémoire. ;)

Reste maintenant à espérer que Touffe54 saura tirer ses choux gras sans hésitation.
08/11/2010, 12h39
patricktoulon

re

oui tu a raison

j'espere qu'il sera entirer son choux gras comme tu dis surtout qu'apres tout c'est lui qui a poster au depart et moi qu'il ai squoiter :mouarf:

au plaisir

Fuseau horaire GMT +2. Il est actuellement 01h06.