Problème avec croix fermeture fichier

**NEC14** · 08/11/2010, 11h09

Bonjour à tous,

J'ai mis en place un code qui empêche l'utilisateur de fermer le classeur à l'aide de la croix située en haut à droite de l'écran.
Pour clore le classeur il doit cliquer sur un bouton spécifique.

Le problème est que si il clique sur la croix, ma barre de menus disparait et il n'est plus possible de fermer le classeur, puisque le bouton de fermeture se situe dans cette barre de menus.

Pouvez-vous m'apporter une explication ou une solution s'il vous plait ?
Merci par avance

Mon bouton est associé à ce module.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Sub fermerClasseur()
    ThisWorkbook.AutoriserFermeture = True
    ThisWorkbook.Save
    ThisWorkbook.Close
End Sub

Dans ThisWorkBook_BeforeClose

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Public AutoriserFermeture As Boolean
 
Private Sub WorkBook_BeforeClose(Cancel As Boolean)
Dim cmdb As CommandBar
    Supp_Cbar
    For Each cmdb In Application.CommandBars
    cmdb.Enabled = True
Next cmdb
    With Application
    .DisplayFullScreen = False
    .CommandBars("Worksheet Menu Bar").Enabled = True
    .CommandBars("Standard").Visible = True
    .CommandBars("Formatting").Visible = True
    .CommandBars("Visual Basic").Visible = True
    .DisplayStatusBar = True
    .DisplayFormulaBar = True
End With
    With ActiveWindow
    .DisplayHeadings = True
    .Zoom = 100
End With
Cancel = Not AutoriserFermeture
Application.Quit
End Sub

**MarcelG** · 08/11/2010, 12h39

Bonjour Nec14, Bonjour le Forum

Pour ma part, j'utilise cette solution en 3 parties

1 - Dans l'objet Thisworkbook

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Quitter As Boolean
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not Quitter Then
    MsgBox "Veuillez utiliser le bouton Quitter"
    Cancel = True
End If
End Sub
 
Public Sub Fermeture()
 
Call EnableSystemMenu
 
Quitter = True
 
If MsgBox("Voulez-vous enregistrer ce fichier ?", vbYesNo) = vbYes Then ThisWorkbook.Save
 
Application.DisplayAlerts = False
 
ActiveWorkbook.Close
 
End Sub

(ne pas oubler de déclarer la variable booléenne "Quitter" en début de module)

2 - Dans un module

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Private Const MF_BYPOSITION As Long = &H400
Private Const mlNUM_SYS_MENU_ITEMS As Long = 9
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 FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName _
As String) As Long
 
Public Sub DisableSystemMenu()
 Dim lHandle As Long, lCount As Long
 
 On Error Resume Next
 lHandle = FindWindowA(vbNullString, Application.Caption)
 If lHandle <> 0 Then
  'désactive la croix de fermeture d'Excel
  'et la commande Fermeture du menu système
  DeleteMenu GetSystemMenu(lHandle, False), 6, &H400
  'supprime le trait de séparation du menu système avant Fermeture
  DeleteMenu GetSystemMenu(lHandle, False), 5, &H400
  'supprime la commande Agrandissement du menu système
  'et la commande Agrandir de la fenêtre
  DeleteMenu GetSystemMenu(lHandle, False), 4, &H400
  'supprime la commande Réduction du menu système
  'et désactive la commande Réduire de la fenêtre
  DeleteMenu GetSystemMenu(lHandle, False), 3, &H400
  'désactive la commande Déplacement du menu système
  DeleteMenu GetSystemMenu(lHandle, False), 2, &H400
  'supprime la commande Déplacement du menu système
  'et désactive la commande Dimension
  DeleteMenu GetSystemMenu(lHandle, False), 1, &H400
  'supprime la commande Restauration du menu système
  'et désactive la commande Restaurer de la fenêtre
  DeleteMenu GetSystemMenu(lHandle, False), 0, &H400
 
 End If
 End Sub
 
Public Sub EnableSystemMenu()
 
'rétablit le menu sytème et les commandes de fenêtre (Réduire, Agrandir, Fermer)
 
 Dim lHandle As Long
 On Error Resume Next
 lHandle = FindWindowA(vbNullString, Application.Caption)
 GetSystemMenu lHandle, True
 End Sub

3 - A ton bouton, nommé ici Btn_Bye, tu associes ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Private Sub Btn_Bye_Click()
 
Application.Run ("Thisworkbook.Fermeture")
 
End Sub

En espérant que ce code te sera utile.

Cordialement.

Marcel

**patricktoulon** · 08/11/2010, 13h02

bonjour

ou alors suprimer le bouton rouge

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
Option Explicit
Public Declare Function GAW Lib "user32" Alias "GetActiveWindow" () As Long
Public Declare Function GWL Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SWL Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_STYLE As Long = -16
Public whdl, forme As Long
 
Sub plus_de_bouton()
  whdl = GAW 'Acquisition du Handle de la fenetre
 
    forme = GWL(whdl, GWL_STYLE) 'Acquisition propriétés
       SWL whdl, GWL_STYLE, forme And Not &H80000
 
End Sub

au plaisir

**NEC14** · 08/11/2010, 14h16

Bonjour patrick,

Ton dernier code "supprimer bouton rouge" tu le mets à l'ouverture du fichier dans ThisWorkBook ?
Merci pour ton aide

**patricktoulon** · 08/11/2010, 14h22

bonjour nec

tout dabors le code se trouve dans un module standard

ensuite dans le module "thisworbook"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
 
Private Sub Workbook_Open()
plus_de_bouton
End Sub

au plaisir

**NEC14** · 08/11/2010, 14h48

Merci beaucoup Patrick, c'est super c'est exactement ce que je voulais.
Super cool !
Amicalement
René

Juste une petite précision, si j'avais voulu garder le trait pour réduire l'écran du fichier que faut-il que j'enlève dans ton code ?

Encore merci

**patricktoulon** · 08/11/2010, 15h25

re
sous cette forme c'est assez dificile neammoins je te donne certaines petite chose

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
 
Sub plus_de_bouton()
  whdl = GAW 'Acquisition du Handle de la fenetre
 
    forme = GWL(whdl, GWL_STYLE) 'Acquisition propriétés
       SWL whdl, GWL_STYLE, forme And Not &H80000
 
End Sub
 
Sub rien_que_agrandir() 'avec le bouton fermer
  whdl = GAW 'Acquisition du Handle de la fenetre
 
    forme = GWL(whdl, GWL_STYLE) 'Acquisition propriétés
       SWL whdl, GWL_STYLE, forme Or &H10000
 
End Sub
 
Sub rien_que_reduire_dans_labarre() 'avec le bouton fermer
  whdl = GAW 'Acquisition du Handle de la fenetre
 
    forme = GWL(whdl, GWL_STYLE) 'Acquisition propriétés
       SWL whdl, GWL_STYLE, forme Or &H20000
       End Sub
 
Sub rien_que_les trois boutons() 'avec le bouton fermer
  whdl = GAW 'Acquisition du Handle de la fenetre
 
    forme = GWL(whdl, GWL_STYLE) 'Acquisition propriétés
       SWL whdl, GWL_STYLE, forme Or &H30000
       End Sub
 
 
 
Sub rien_que_l_elasticité() 'avec le bouton fermer
  whdl = GAW 'Acquisition du Handle de la fenetre
 
    forme = GWL(whdl, GWL_STYLE) 'Acquisition propriétés
       SWL whdl, GWL_STYLE, forme Or &H40000
       End Sub
 
 Sub la_totale() 'avec le bouton fermer
  whdl = GAW 'Acquisition du Handle de la fenetre
 
    forme = GWL(whdl, GWL_STYLE) 'Acquisition propriétés
       SWL whdl, GWL_STYLE, forme Or &H70000
       End Sub

je bosse sur une autre version en passant par un autre chemein pour bloquer le bouton rouge tout en ayant le bouton reduire si j 'ai bien compris

au plaisir

**NEC14** · 08/11/2010, 15h56

Oui c'est bien cela, je souhaite garder uniquement le bouton réduire.

Je viens de tester les codes proposés, mais dans tous les cas de figures ou je n'ai rien ou j'ai les 3 symboles.

J'ai encore dû faire quelque chose qu'il ne faut pas ou bien je n'ai rien compris.
Merci pour ton aide

**patricktoulon** · 08/11/2010, 16h49

re

bon ben voila servi sur un plataux

dans cet exemple je suprime tout les boutons pour ne remetre que le bouton fermer et reduire et ensuite boquer la fonction du bouton fermer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Public Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Public Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GWL Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SWL Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_STYLE As Long = -16
Public forme As Long
Public Const SC_CLOSE = &HF060&
Public Const MF_BYCOMMAND = &H0&
Public hSysMenu As Long
Public lehandle As Long
 Sub depart()
 'on identifie le handle de la fenetre
 lehandle = FindWindowA(vbNullString, Application.Caption)
 forme = GWL(lehandle, GWL_STYLE) 'Acquisition propriétés
 'on applique le style a la fenetre
 SWL lehandle, GWL_STYLE, forme And Not &H70000 Or &H20000
 'on bloque le bouton stop
 hSysMenu = GetSystemMenu(lehandle, False)
 RemoveMenu hSysMenu, SC_CLOSE, MF_BYCOMMAND
End Sub
Sub fin()
lehandle = FindWindowA(vbNullString, Application.Caption)
forme = GWL(lehandle, GWL_STYLE) 'Acquisition propriétés
SWL lehandle, GWL_STYLE, forme Or &H70000
hSysMenu = GetSystemMenu(lehandle, True)
RemoveMenu hSysMenu, SC_CLOSE, MF_BYCOMMAND
End Sub

'dans le module thisworkbook

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
 Private Sub Workbook_BeforeClose(Cancel As Boolean)
fin
End Sub
Private Sub Workbook_Open()
depart
End Sub

au plaisir

**NEC14** · 09/11/2010, 15h11

Bonjour Patrick,

Je te prie de m'excuser d'avoir tardé à te répondre mais ce matin j'ai eu un gros soucis avec mon application. Comme tu pourras le constater, j'ai déposé un post ce matin concernant un soucis de DLL. De ce fait, je ne pouvais plus ouvrir mon fichier.
Il m'a fallut tout recommencer le travail réalisé hier.

Sinon au sujet de ton code, quoi dire sinon chapeau bas. Je suis très admiratif devant autant de maîtrise de l'outil vba. Ton code marche à souhait.

Quoi faire pour te remercier ?

A bientôt et mille mercis
Amicalement
René

**patricktoulon** · 09/11/2010, 18h40

bonjour nec

pour me remercier tu n'a qu'a cliquer resolu pour que ca serve a d'autres
et voter pourquoi pas
enfin j'espere que ca te sera utile

au plaisr de te rendre service

Problème avec croix fermeture fichier [Toutes versions]

Macros et VBA Excel

Discussions similaires

Partager

Partager