Discussion :

[apdf1]

Bonjour,

je suis a la recherche d'un code pour interdire de fermer excel par la croix mais par un bouton qui enregistre et ferme excel dont le code est ceci:

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
Private Sub CommandButton1_Click()
Select Case MsgBox(" Voulez-vous sauvegarder ? ", vbYesNoCancel)
 
Case vbYes
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.Quit
ActiveWindow.Close
 
Case vbNo
Application.DisplayAlerts = False
Application.Quit
ActiveWindow.Close
 
Case Cancel
End Select
 
End Sub

Mais il me manque le code pour interdire la fermeture par la croix en haut a droite.

D'avance merci

Cordialement

Max

[patricktoulon]

bonjour

une solution un peu radicale certe mais fonctionnelle serait d'enlever les boutons de l'application

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
 
Option Explicit
 
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
 
 
Sub restaurer_croix_sys()
  Dim hwnd As Long
  hwnd = FindWindowA(vbNullString, Application.Caption)
  SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) Or &H80000
End Sub
 
Sub supprimer_croix_sys()
  Dim hwnd As Long
  hwnd = FindWindowA(vbNullString, Application.Caption)
  SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF
End Sub

Sinon tu a la solution de bloquer le bouton fermer comme ceci
je precise que tu avais divers exemples dans la faq en tapant "croix",fermer,caption sur le textbox de recherche

allez voila le code :

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 Const SC_CLOSE = &HF060&
Private Const MF_BYCOMMAND = &H0&
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
 
Private Declare Function RemoveMenu 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
 
 
'faire appel a cette macro au moment que tu veux ca pour effet de bloquer l'action du bouton fermer de l'application
 Sub bloque_la_croix()
Dim hSysMenu As Long
Dim handleapp As Long
    handleapp = FindWindowA(vbNullString, Application.Caption)
    If handleapp > 0 Then
        hSysMenu = GetSystemMenu(handleapp, False)
        RemoveMenu hSysMenu, SC_CLOSE, MF_BYCOMMAND
    Else
        MsgBox "Handle de " & Application.Caption & " Introuvable", vbCritical
    End If
End Sub

au plaisir

[apdf1]

Bonjour patricktoulon

Je te remercie j'ai mis ton code dans ThisWorkbook j'ai enregistré je l'ai ouvert et j'ai fermé par la croix?
@+

Max

[patricktoulon]

re

tu prend l'un des deux codes celui qui te plais

tu le met dans un module standard

et tu appel la macro dans le module "thisworkbook" open

allez fait comme ceci:

Dans le thisworkbook tu peux mettre

Code :

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

1
2
3
Private Sub Workbook_Open()
supprimer_croix_sys ' ca t'enlevera les bouton de la fenêtre
End Sub

ou alors tu met!!

Code :

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

1
2
3
Private Sub Workbook_Open()
bloque_la_croix' ça te bloquera le bouton fermer de la fenêtre 
End Sub

dans le module standard

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
 
Option Explicit
 Private Const SC_CLOSE = &HF060&
Private Const MF_BYCOMMAND = &H0&
 
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
 
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
 
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
 
 
 
Sub restaurer_croix_sys()
  Dim hwnd As Long
  hwnd = FindWindowA(vbNullString, Application.Caption)
  SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) Or &H80000
End Sub
 
Sub supprimer_croix_sys()
  Dim hwnd As Long
  hwnd = FindWindowA(vbNullString, Application.Caption)
  SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF
End Sub
 
'faire appel a cette macro au moment que tu veux ca pour effet de bloquer l'action du bouton fermer de l'application
 
 
 Sub bloque_la_croix()
Dim hSysMenu As Long
Dim handleapp As Long
    handleapp = FindWindowA(vbNullString, Application.Caption)
    If handleapp > 0 Then
        hSysMenu = GetSystemMenu(handleapp, False)
        RemoveMenu hSysMenu, SC_CLOSE, MF_BYCOMMAND
    Else
        MsgBox "Handle de " & Application.Caption & " Introuvable", vbCritical
    End If

il m'est difficile d'etre plus clair en tout cas chez moi ca fonctionne tres bien


au plaisir

[apdf1]

Bonjour patricktoulon

Sa marche Nickel et trés clair les explications je te remercie beaucoup et te souhaite une bonne journée

@+

Max