Macro Fermeture Fichier

[RUID]

Bonjour,

encore merci pour ce forum qui m'aide beaucoup au quotidien.
J'ai un souci pour fermer une application

Dans ThisWorkbook :
_________________________________________
'Pour désactiver la croix fermer du menu Excel
Option Explicit
Dim Verrou As Boolean
Private Sub Workbook_Open()
'Pour ouvrir sur le menu
Worksheets("MENU").Select
'Pour masquer les barres d'outils Excel
Dim CmdB As CommandBar
For Each CmdB In Application.CommandBars
CmdB.Enabled = False
Next CmdB
'Pour le message à l'ouverture
MsgBox "Bienvenue sur l'application de suivi de projet " & Chr(10) & " " & Chr(10) & " Avez-vous créé le projet dans la GPAO ?" & Chr(10) & " Avez-vous créé les répertoires de classement ?", , "APPLICATION xx - BE"
VerrouON
End Sub
'Pour désactiver la croix fermer du menu Excel
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Cancel = Verrou
End Sub
'Pour désactiver la croix fermer du menu Excel
Sub VerrouON()
Verrou = True
End Sub

Dans le module :
__________________________________________
Sub Quitter()
Msg = "Voulez-vous QUITTER le suivi de projet ? "
Style = vbYesNo + vbQuestion + vbDefaultButton1
Title = "XX- BE " ' nom de programme
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then
Msg = "Voulez-vous ENREGISTRER les modifications apportées ?"
Style = vbYesNo + vbQuestion + vbDefaultButton1
Title = "XX - BE" ' nom de programme
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then
ActiveWorkbook.Save
Call fermer
Range("A1").Select
Call fermer
Else
Call fermer
End If
Else
End If
'Pour remettre le menu et les barres d'outils
Dim CmdB As CommandBar
For Each CmdB In Application.CommandBars
CmdB.Enabled = True
Next CmdB
End Sub

Sub fermer()
Verrou = True
'Pour remettre le menu et les barres d'outils
Dim CmdB As CommandBar
For Each CmdB In Application.CommandBars
CmdB.Enabled = True
Next CmdB
ThisWorkbook.Close False
End Sub

CODE RECUPERE POUR FAIRE CELA, MAIS JE NE SAIS PAS OU PLACER LES CHOSES POUR QUITTER
___________________________________________
Option Explicit
Dim Verrou As Boolean

Private Sub Workbook_Open()
VerrouON
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Cancel = Verrou
End Sub

Sub VerrouON()
Verrou = True
End Sub

Sub VerrouOFF()
Verrou = False
End Sub

Sub Porte()
VerrouOFF
ThisWorkbook.Close False
End Sub

D'avance merci pour votre aide.

RUID

 

[RUID]

Re : Macro Fermeture Fichier

Bon, j'ai réussi à me débrouiller tout seul.
Ci-dessous la solution retenue à partir des exemples sur le forum :

Dans This workbook
Option Explicit
'Declaration des variables pour supprimer la fermeture par la croix Excel
Public Autoriser_Fermeture As Boolean

Dans la feuille
Private Sub Bouton_fermer_Click()

Msg = "Voulez-vous QUITTER la saisie des bons de commande ? "
Style = vbYesNo + vbQuestion + vbDefaultButton1
Title = "Entreprise xx "
response = MsgBox(Msg, Style, Title, Help, Ctxt)
'si non, rien ne se passe
If response = vbNo Then
End
End If
If response = vbYes Then
Msg = "Voulez-vous ENREGISTRER les modifications apportées ?"
Style = vbYesNo + vbQuestion + vbDefaultButton1
Title = "Entreprise xxx"
response = MsgBox(Msg, Style, Title, Help, Ctxt)
If response = vbYes Then
ActiveWorkbook.Save
Call Fermer
Range("A1").Select
Call Fermer
Else
Call Fermer
End If
Else
End If
End Sub

Sub Fermer()
'Pour remettre le menu et les barres d'outils
Dim CmdB As CommandBar
For Each CmdB In Application.CommandBars
CmdB.Enabled = True
Next CmdB
Autoriser_Fermeture = True
ActiveWorkbook.Close
End Sub

 

[RUID]

Re : Macro Fermeture Fichier

Oups, petite correction :

Dans Thisworkbook :
Private Sub Workbook_Open()

Worksheets("MENU").Select
'Variable de test qui va permettre de bloquer la sortie par la croix rouge
Autoriser_Fermeture = False

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Annule l'effet de la constante par defaut qui contient l'etat de l'enregistrement pour ne pas avoir
'le message qui demmande d'enregistrer avant de fermer
If ActiveWorkbook.Name = "FR-014 Bon de commande.xls" Then
Me.Saved = True
'Teste si la fermeure vient du bouton QUITTER ou bien de la croix rouge
If Not Autoriser_Fermeture Then
'Ici ça vient de la croix rouge
Cancel = True
MsgBox " Vous devez utiliser le bouton" & Chr(10) & " " & Chr(10) & "[QUITTER L'APPICATION] du MENU principal. ", , " SORTIE NON AUTORISEE !!!"
Else
'Ici ça vient du bouton il n'y a rien à faire car je traite ce cas dans la procedure du bouton
End If
Else
'Ici ça vient de la croix rouge mais on est sur un autre classeur que "FR-014 Bon de commande.xls"
'donc je ferme tous les classeurs à part "FR-014 Bon de commande.xls"
For Each Classeur In Workbooks
If Classeur.Name <> "FR-014 Bon de commande.xls" Then Classeur.Close
Next Classeur
End If
End Sub

Dans le module :
Option Explicit
'Declaration des variables pour supprimer la fermeture par la croix Excel
Public Autoriser_Fermeture As Boolean

et dans la feuille :

Private Sub Bouton_fermer_Click()

Msg = "Voulez-vous QUITTER la saisie des bons de commande ? "
Style = vbYesNo + vbQuestion + vbDefaultButton1
Title = "Entreprise BAULARD Père & Fils "
response = MsgBox(Msg, Style, Title, Help, Ctxt)
'si non, rien ne se passe
If response = vbNo Then
End
End If
If response = vbYes Then
Msg = "Voulez-vous ENREGISTRER les modifications apportées ?"
Style = vbYesNo + vbQuestion + vbDefaultButton1
Title = "Entreprise BAULARD Père & Fils"
response = MsgBox(Msg, Style, Title, Help, Ctxt)
If response = vbYes Then
ActiveWorkbook.Save
Call Fermer
Range("A1").Select
Call Fermer
Else
Call Fermer
End If
Else
End If
End Sub

Sub Fermer()
'Pour remettre le menu et les barres d'outils
Dim CmdB As CommandBar
For Each CmdB In Application.CommandBars
CmdB.Enabled = True
Next CmdB
Autoriser_Fermeture = True
ActiveWorkbook.Close
End Sub