Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel (vba) sortie de procédure ...

(vba) sortie de procédure ...

10 réponses
Avatar
j-pascal
Bonjour,

Si dans la procédure "Validité", je ne mets pas le bon MdP, la procédure
"fermeture" est appelée et j'ai bien le message "Terminé !" mais le classeur
reste ouvert et les procédures suivantes s'enchainent comme si de rien
n'était ...

Question : pourquoi le classeur ne se ferme pas ?

Merci d'avance pour vos lumières...

'----------------------------------------------------------
Option Explicit
Dim LaDate As Date, LHeure As Date

Sub auto_open()

Dim sh As Worksheet

Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Sheets
sh.Visible = xlSheetVisible
Sheets("accueil").Visible = xlSheetVeryHidden 'ajout du 10/08
Next

For Each sh In ThisWorkbook.Sheets
sh.Protect Password:="", DrawingObjects:=False, Contents:=True,
Scenarios:=False, userinterfaceonly:=True
sh.EnableSelection = xlUnlockedCells
Next

Sheets("import toto").Select
ActiveSheet.Unprotect
Sheets("synth. toto").Select

Application.ScreenUpdating = True

Call Validité
Call DateEtHeure
'Call PlageRestreinte

MsgBox "Bonjour Xavier !" & Chr(10) & Chr(10) & "Nous sommes le " &
LaDate & Chr(10) & Chr(10) & "Il est " & Format(LHeure, "hh:mm"), vbOKOnly +
vbInformation, "hello"
End Sub

Sub DateEtHeure()
LaDate = Date
LHeure = Time
End Sub

Sub SDAF()
Call msg_SDAF
MsgBox "Pensez à sélectionner un onglet pour la saisie !", vbOKOnly +
vbInformation, "rappel"
End Sub
'
'Sub PlageRestreinte()
' ActiveSheet.ScrollArea = "A1:AT110"
'End Sub

Private Sub Validité()

Dim JoursDeValidité As Integer
Dim Code As Variant
Dim réponse6 As Integer

JoursDeValidité = Range("DF2").Value

If JoursDeValidité > 0 Then
MsgBox ("Validité de l'application : " & JoursDeValidité & "
jour(s)"), vbOKOnly + vbInformation, "A noter"
Else '(date expirée)
MsgBox ("La date limite d'utilisation a expiré !"), vbOKOnly +
vbInformation, "Etat ..."
Code = InputBox("Entrez le nouveau code ...", "Prolongation ...")

If Code <> "0000" Then
réponse6 = MsgBox("Code erroné !", vbRetryCancel)
If réponse6 = vbCancel Then '(l'utilisateur annule)
Call fermeture
Else
If réponse6 = vbRetry Then '(l'utilisateur recommence)
Code = InputBox("Entrez le nouveau code ...", "Contactez
l'auteur ...")
If Code <> "0000" Then
MsgBox "ttt"
Call fermeture
End If
End If
End If
End If
End If

ActiveSheet.Protect Password:="" '17/08/07
End Sub

Private Sub fermeture()
Application.EnableCancelKey = xlDisabled
On Error GoTo fin
MsgBox "Terminé !"
fin:
ThisWorkbook.Close True
End Sub
'---------------------------------------------------------



Et dans ThisWorkbook :
'--------------------------------------------------------
'Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)

Dim tst
If SaveAsUI Then

MsgBox "Désolé, l'option Enregistrer sous... est impossible !",
vbExclamation, "choix possibles : Enregistrer ou Fermer"

Cancel = True

Else
tst = MsgBox("Voulez-vous enregistrer une copie sous la forme : " &
"Date Heure Fichier.xls" & " ?", vbYesNo)
'& vbCrLf &

With ThisWorkbook
ChDir .Path
If tst = 6 Then
'.SaveCopyAs Format(Now, "yyyymmmdd-hhnn") & .Name
.SaveCopyAs Format(Now, "yyyymmmdd-hh""h""nn") & " " & .Name

Else
Cancel = True
End If
End With
End If


Dim sh As Worksheet

Application.EnableCancelKey = xlDisabled

Application.ScreenUpdating = False


Sheets("accueil").Visible = xlSheetVisible 'Feuil15.Visible

For Each sh In ThisWorkbook.Sheets
sh.Protect userinterfaceonly:=True 'indispensable ??
If sh.CodeName <> "Feuil15" Then
sh.Visible = xlSheetVeryHidden
End If
Next

End Sub
'------------------------------------------------------------

JP






--
Cordialement @+
JP
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Daniel
Bonjour.
Essaie un exit sub après le thisworkbook.close true
Cordialement.
Daniel
"j-pascal" a écrit dans le message de news:

Bonjour,

Si dans la procédure "Validité", je ne mets pas le bon MdP, la procédure
"fermeture" est appelée et j'ai bien le message "Terminé !" mais le
classeur reste ouvert et les procédures suivantes s'enchainent comme si de
rien n'était ...

Question : pourquoi le classeur ne se ferme pas ?

Merci d'avance pour vos lumières...

'----------------------------------------------------------
Option Explicit
Dim LaDate As Date, LHeure As Date

Sub auto_open()

Dim sh As Worksheet

Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Sheets
sh.Visible = xlSheetVisible
Sheets("accueil").Visible = xlSheetVeryHidden 'ajout du 10/08
Next

For Each sh In ThisWorkbook.Sheets
sh.Protect Password:="", DrawingObjects:úlse, Contents:=True,
Scenarios:úlse, userinterfaceonly:=True
sh.EnableSelection = xlUnlockedCells
Next

Sheets("import toto").Select
ActiveSheet.Unprotect
Sheets("synth. toto").Select

Application.ScreenUpdating = True

Call Validité
Call DateEtHeure
'Call PlageRestreinte

MsgBox "Bonjour Xavier !" & Chr(10) & Chr(10) & "Nous sommes le " &
LaDate & Chr(10) & Chr(10) & "Il est " & Format(LHeure, "hh:mm"), vbOKOnly
+ vbInformation, "hello"
End Sub

Sub DateEtHeure()
LaDate = Date
LHeure = Time
End Sub

Sub SDAF()
Call msg_SDAF
MsgBox "Pensez à sélectionner un onglet pour la saisie !", vbOKOnly +
vbInformation, "rappel"
End Sub
'
'Sub PlageRestreinte()
' ActiveSheet.ScrollArea = "A1:AT110"
'End Sub

Private Sub Validité()

Dim JoursDeValidité As Integer
Dim Code As Variant
Dim réponse6 As Integer

JoursDeValidité = Range("DF2").Value

If JoursDeValidité > 0 Then
MsgBox ("Validité de l'application : " & JoursDeValidité & "
jour(s)"), vbOKOnly + vbInformation, "A noter"
Else '(date expirée)
MsgBox ("La date limite d'utilisation a expiré !"), vbOKOnly +
vbInformation, "Etat ..."
Code = InputBox("Entrez le nouveau code ...", "Prolongation ...")

If Code <> "0000" Then
réponse6 = MsgBox("Code erroné !", vbRetryCancel)
If réponse6 = vbCancel Then '(l'utilisateur annule)
Call fermeture
Else
If réponse6 = vbRetry Then '(l'utilisateur recommence)
Code = InputBox("Entrez le nouveau code ...",
"Contactez l'auteur ...")
If Code <> "0000" Then
MsgBox "ttt"
Call fermeture
End If
End If
End If
End If
End If

ActiveSheet.Protect Password:="" '17/08/07
End Sub

Private Sub fermeture()
Application.EnableCancelKey = xlDisabled
On Error GoTo fin
MsgBox "Terminé !"
fin:
ThisWorkbook.Close True
End Sub
'---------------------------------------------------------



Et dans ThisWorkbook :
'--------------------------------------------------------
'Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)

Dim tst
If SaveAsUI Then

MsgBox "Désolé, l'option Enregistrer sous... est impossible !",
vbExclamation, "choix possibles : Enregistrer ou Fermer"

Cancel = True

Else
tst = MsgBox("Voulez-vous enregistrer une copie sous la forme : " &
"Date Heure Fichier.xls" & " ?", vbYesNo)
'& vbCrLf &

With ThisWorkbook
ChDir .Path
If tst = 6 Then
'.SaveCopyAs Format(Now, "yyyymmmdd-hhnn") & .Name
.SaveCopyAs Format(Now, "yyyymmmdd-hh""h""nn") & " " &
.Name

Else
Cancel = True
End If
End With
End If


Dim sh As Worksheet

Application.EnableCancelKey = xlDisabled

Application.ScreenUpdating = False


Sheets("accueil").Visible = xlSheetVisible 'Feuil15.Visible

For Each sh In ThisWorkbook.Sheets
sh.Protect userinterfaceonly:=True 'indispensable ??
If sh.CodeName <> "Feuil15" Then
sh.Visible = xlSheetVeryHidden
End If
Next

End Sub
'------------------------------------------------------------

JP






--
Cordialement @+
JP


Avatar
j-pascal
Bonsoir,


Essaie un exit sub après le thisworkbook.close true


Sauf erreur de ma part, ça ne change rien !

Ca embraye sur : Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean,
Cancel As Boolean), et si je clique sur "non", le classeur reste ouvert et
je peux l'utiliser comme si de rien n'était ...

Par ailleurs, comme la macro "validité" s'exécute à l'ouverture du classeur,
on ne devrait même pas avoir de msg demandant si on veut fermer en
enregistrant ou non, puisque par définition, on a encore rien pu faire !!

JP

Cordialement.
Daniel
"j-pascal" a écrit dans le message de news:

Bonjour,

Si dans la procédure "Validité", je ne mets pas le bon MdP, la procédure
"fermeture" est appelée et j'ai bien le message "Terminé !" mais le
classeur reste ouvert et les procédures suivantes s'enchainent comme si
de rien n'était ...

Question : pourquoi le classeur ne se ferme pas ?

Merci d'avance pour vos lumières...

'----------------------------------------------------------
Option Explicit
Dim LaDate As Date, LHeure As Date

Sub auto_open()

Dim sh As Worksheet

Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Sheets
sh.Visible = xlSheetVisible
Sheets("accueil").Visible = xlSheetVeryHidden 'ajout du
10/08
Next

For Each sh In ThisWorkbook.Sheets
sh.Protect Password:="", DrawingObjects:úlse,
Contents:=True, Scenarios:úlse, userinterfaceonly:=True
sh.EnableSelection = xlUnlockedCells
Next

Sheets("import toto").Select
ActiveSheet.Unprotect
Sheets("synth. toto").Select

Application.ScreenUpdating = True

Call Validité
Call DateEtHeure
'Call PlageRestreinte

MsgBox "Bonjour Xavier !" & Chr(10) & Chr(10) & "Nous sommes le " &
LaDate & Chr(10) & Chr(10) & "Il est " & Format(LHeure, "hh:mm"),
vbOKOnly + vbInformation, "hello"
End Sub

Sub DateEtHeure()
LaDate = Date
LHeure = Time
End Sub

Sub SDAF()
Call msg_SDAF
MsgBox "Pensez à sélectionner un onglet pour la saisie !", vbOKOnly +
vbInformation, "rappel"
End Sub
'
'Sub PlageRestreinte()
' ActiveSheet.ScrollArea = "A1:AT110"
'End Sub

Private Sub Validité()

Dim JoursDeValidité As Integer
Dim Code As Variant
Dim réponse6 As Integer

JoursDeValidité = Range("DF2").Value

If JoursDeValidité > 0 Then
MsgBox ("Validité de l'application : " & JoursDeValidité & "
jour(s)"), vbOKOnly + vbInformation, "A noter"
Else '(date expirée)
MsgBox ("La date limite d'utilisation a expiré !"), vbOKOnly +
vbInformation, "Etat ..."
Code = InputBox("Entrez le nouveau code ...", "Prolongation ...")

If Code <> "0000" Then
réponse6 = MsgBox("Code erroné !", vbRetryCancel)
If réponse6 = vbCancel Then '(l'utilisateur annule)
Call fermeture
Else
If réponse6 = vbRetry Then '(l'utilisateur recommence)
Code = InputBox("Entrez le nouveau code ...",
"Contactez l'auteur ...")
If Code <> "0000" Then
MsgBox "ttt"
Call fermeture
End If
End If
End If
End If
End If

ActiveSheet.Protect Password:="" '17/08/07
End Sub

Private Sub fermeture()
Application.EnableCancelKey = xlDisabled
On Error GoTo fin
MsgBox "Terminé !"
fin:
ThisWorkbook.Close True
End Sub
'---------------------------------------------------------



Et dans ThisWorkbook :
'--------------------------------------------------------
'Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)

Dim tst
If SaveAsUI Then

MsgBox "Désolé, l'option Enregistrer sous... est impossible !",
vbExclamation, "choix possibles : Enregistrer ou Fermer"

Cancel = True

Else
tst = MsgBox("Voulez-vous enregistrer une copie sous la forme : "
& "Date Heure Fichier.xls" & " ?", vbYesNo)
'& vbCrLf &

With ThisWorkbook
ChDir .Path
If tst = 6 Then
'.SaveCopyAs Format(Now, "yyyymmmdd-hhnn") & .Name
.SaveCopyAs Format(Now, "yyyymmmdd-hh""h""nn") & " " &
.Name

Else
Cancel = True
End If
End With
End If


Dim sh As Worksheet

Application.EnableCancelKey = xlDisabled

Application.ScreenUpdating = False


Sheets("accueil").Visible = xlSheetVisible 'Feuil15.Visible

For Each sh In ThisWorkbook.Sheets
sh.Protect userinterfaceonly:=True 'indispensable ??
If sh.CodeName <> "Feuil15" Then
sh.Visible = xlSheetVeryHidden
End If
Next

End Sub
'------------------------------------------------------------

JP






--
Cordialement @+
JP






Avatar
Daniel
Essaie de mettre un point d'arrêt sur msgbox et poursuis l'exécution pas à
pas.
Daniel
"j-pascal" a écrit dans le message de news:

Bonsoir,


Essaie un exit sub après le thisworkbook.close true


Sauf erreur de ma part, ça ne change rien !

Ca embraye sur : Private Sub Workbook_BeforeSave(ByVal SaveAsUI As
Boolean, Cancel As Boolean), et si je clique sur "non", le classeur reste
ouvert et je peux l'utiliser comme si de rien n'était ...

Par ailleurs, comme la macro "validité" s'exécute à l'ouverture du
classeur, on ne devrait même pas avoir de msg demandant si on veut fermer
en enregistrant ou non, puisque par définition, on a encore rien pu faire
!!

JP

Cordialement.
Daniel
"j-pascal" a écrit dans le message de news:

Bonjour,

Si dans la procédure "Validité", je ne mets pas le bon MdP, la procédure
"fermeture" est appelée et j'ai bien le message "Terminé !" mais le
classeur reste ouvert et les procédures suivantes s'enchainent comme si
de rien n'était ...

Question : pourquoi le classeur ne se ferme pas ?

Merci d'avance pour vos lumières...

'----------------------------------------------------------
Option Explicit
Dim LaDate As Date, LHeure As Date

Sub auto_open()

Dim sh As Worksheet

Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Sheets
sh.Visible = xlSheetVisible
Sheets("accueil").Visible = xlSheetVeryHidden 'ajout du
10/08
Next

For Each sh In ThisWorkbook.Sheets
sh.Protect Password:="", DrawingObjects:úlse,
Contents:=True, Scenarios:úlse, userinterfaceonly:=True
sh.EnableSelection = xlUnlockedCells
Next

Sheets("import toto").Select
ActiveSheet.Unprotect
Sheets("synth. toto").Select

Application.ScreenUpdating = True

Call Validité
Call DateEtHeure
'Call PlageRestreinte

MsgBox "Bonjour Xavier !" & Chr(10) & Chr(10) & "Nous sommes le " &
LaDate & Chr(10) & Chr(10) & "Il est " & Format(LHeure, "hh:mm"),
vbOKOnly + vbInformation, "hello"
End Sub

Sub DateEtHeure()
LaDate = Date
LHeure = Time
End Sub

Sub SDAF()
Call msg_SDAF
MsgBox "Pensez à sélectionner un onglet pour la saisie !", vbOKOnly +
vbInformation, "rappel"
End Sub
'
'Sub PlageRestreinte()
' ActiveSheet.ScrollArea = "A1:AT110"
'End Sub

Private Sub Validité()

Dim JoursDeValidité As Integer
Dim Code As Variant
Dim réponse6 As Integer

JoursDeValidité = Range("DF2").Value

If JoursDeValidité > 0 Then
MsgBox ("Validité de l'application : " & JoursDeValidité & "
jour(s)"), vbOKOnly + vbInformation, "A noter"
Else '(date expirée)
MsgBox ("La date limite d'utilisation a expiré !"), vbOKOnly +
vbInformation, "Etat ..."
Code = InputBox("Entrez le nouveau code ...", "Prolongation ...")

If Code <> "0000" Then
réponse6 = MsgBox("Code erroné !", vbRetryCancel)
If réponse6 = vbCancel Then '(l'utilisateur annule)
Call fermeture
Else
If réponse6 = vbRetry Then '(l'utilisateur recommence)
Code = InputBox("Entrez le nouveau code ...",
"Contactez l'auteur ...")
If Code <> "0000" Then
MsgBox "ttt"
Call fermeture
End If
End If
End If
End If
End If

ActiveSheet.Protect Password:="" '17/08/07
End Sub

Private Sub fermeture()
Application.EnableCancelKey = xlDisabled
On Error GoTo fin
MsgBox "Terminé !"
fin:
ThisWorkbook.Close True
End Sub
'---------------------------------------------------------



Et dans ThisWorkbook :
'--------------------------------------------------------
'Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)

Dim tst
If SaveAsUI Then

MsgBox "Désolé, l'option Enregistrer sous... est impossible !",
vbExclamation, "choix possibles : Enregistrer ou Fermer"

Cancel = True

Else
tst = MsgBox("Voulez-vous enregistrer une copie sous la forme : "
& "Date Heure Fichier.xls" & " ?", vbYesNo)
'& vbCrLf &

With ThisWorkbook
ChDir .Path
If tst = 6 Then
'.SaveCopyAs Format(Now, "yyyymmmdd-hhnn") & .Name
.SaveCopyAs Format(Now, "yyyymmmdd-hh""h""nn") & " " &
.Name

Else
Cancel = True
End If
End With
End If


Dim sh As Worksheet

Application.EnableCancelKey = xlDisabled

Application.ScreenUpdating = False


Sheets("accueil").Visible = xlSheetVisible 'Feuil15.Visible

For Each sh In ThisWorkbook.Sheets
sh.Protect userinterfaceonly:=True 'indispensable ??
If sh.CodeName <> "Feuil15" Then
sh.Visible = xlSheetVeryHidden
End If
Next

End Sub
'------------------------------------------------------------

JP






--
Cordialement @+
JP









Avatar
j-pascal
Bonsoir,

J'ai mis un point d'arrêt comme tu l'as dit ...

Private Sub fermeture()
Application.EnableCancelKey = xlDisabled
On Error GoTo fin
MsgBox "Terminé !" 'jai bien le msgbox
fin:
ThisWorkbook.Close True 'surligné en jaune, et ça passe à (*)
Exit Sub '18/08 'AMHA cela ne change rien
End Sub

(*) (ThisWorkbook)

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)

Dim tst
If SaveAsUI Then 'etc... et là si l'utilisateur ne veut pas
enregistrer, l'application reste ouverte !
Par contre, ce qui est bizarre, c'est que lorsque j'exécute le code pas à
pas et que j'arrête la macro (bouton réinitialiser", après la 1ère ligne de
"Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)", le classeur se ferme !!!

Je suis un peu pessimiste ;-(

@+ ?

JP


"Daniel" a écrit dans le message de news:
OL9z$
Essaie de mettre un point d'arrêt sur msgbox et poursuis l'exécution pas à
pas.
Daniel
"j-pascal" a écrit dans le message de news:

Bonsoir,


Essaie un exit sub après le thisworkbook.close true


Sauf erreur de ma part, ça ne change rien !

Ca embraye sur : Private Sub Workbook_BeforeSave(ByVal SaveAsUI As
Boolean, Cancel As Boolean), et si je clique sur "non", le classeur reste
ouvert et je peux l'utiliser comme si de rien n'était ...

Par ailleurs, comme la macro "validité" s'exécute à l'ouverture du
classeur, on ne devrait même pas avoir de msg demandant si on veut fermer
en enregistrant ou non, puisque par définition, on a encore rien pu faire
!!

JP

Cordialement.
Daniel
"j-pascal" a écrit dans le message de news:

Bonjour,

Si dans la procédure "Validité", je ne mets pas le bon MdP, la
procédure "fermeture" est appelée et j'ai bien le message "Terminé !"
mais le classeur reste ouvert et les procédures suivantes s'enchainent
comme si de rien n'était ...

Question : pourquoi le classeur ne se ferme pas ?

Merci d'avance pour vos lumières...

'----------------------------------------------------------
Option Explicit
Dim LaDate As Date, LHeure As Date

Sub auto_open()

Dim sh As Worksheet

Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Sheets
sh.Visible = xlSheetVisible
Sheets("accueil").Visible = xlSheetVeryHidden 'ajout du
10/08
Next

For Each sh In ThisWorkbook.Sheets
sh.Protect Password:="", DrawingObjects:úlse,
Contents:=True, Scenarios:úlse, userinterfaceonly:=True
sh.EnableSelection = xlUnlockedCells
Next

Sheets("import toto").Select
ActiveSheet.Unprotect
Sheets("synth. toto").Select

Application.ScreenUpdating = True

Call Validité
Call DateEtHeure
'Call PlageRestreinte

MsgBox "Bonjour Xavier !" & Chr(10) & Chr(10) & "Nous sommes le " &
LaDate & Chr(10) & Chr(10) & "Il est " & Format(LHeure, "hh:mm"),
vbOKOnly + vbInformation, "hello"
End Sub

Sub DateEtHeure()
LaDate = Date
LHeure = Time
End Sub

Sub SDAF()
Call msg_SDAF
MsgBox "Pensez à sélectionner un onglet pour la saisie !", vbOKOnly
+ vbInformation, "rappel"
End Sub
'
'Sub PlageRestreinte()
' ActiveSheet.ScrollArea = "A1:AT110"
'End Sub

Private Sub Validité()

Dim JoursDeValidité As Integer
Dim Code As Variant
Dim réponse6 As Integer

JoursDeValidité = Range("DF2").Value

If JoursDeValidité > 0 Then
MsgBox ("Validité de l'application : " & JoursDeValidité & "
jour(s)"), vbOKOnly + vbInformation, "A noter"
Else '(date expirée)
MsgBox ("La date limite d'utilisation a expiré !"), vbOKOnly +
vbInformation, "Etat ..."
Code = InputBox("Entrez le nouveau code ...", "Prolongation
...")

If Code <> "0000" Then
réponse6 = MsgBox("Code erroné !", vbRetryCancel)
If réponse6 = vbCancel Then '(l'utilisateur annule)
Call fermeture
Else
If réponse6 = vbRetry Then '(l'utilisateur recommence)
Code = InputBox("Entrez le nouveau code ...",
"Contactez l'auteur ...")
If Code <> "0000" Then
MsgBox "ttt"
Call fermeture
End If
End If
End If
End If
End If

ActiveSheet.Protect Password:="" '17/08/07
End Sub

Private Sub fermeture()
Application.EnableCancelKey = xlDisabled
On Error GoTo fin
MsgBox "Terminé !"
fin:
ThisWorkbook.Close True
End Sub
'---------------------------------------------------------



Et dans ThisWorkbook :
'--------------------------------------------------------
'Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)

Dim tst
If SaveAsUI Then

MsgBox "Désolé, l'option Enregistrer sous... est impossible !",
vbExclamation, "choix possibles : Enregistrer ou Fermer"

Cancel = True

Else
tst = MsgBox("Voulez-vous enregistrer une copie sous la forme :
" & "Date Heure Fichier.xls" & " ?", vbYesNo)
'& vbCrLf &

With ThisWorkbook
ChDir .Path
If tst = 6 Then
'.SaveCopyAs Format(Now, "yyyymmmdd-hhnn") & .Name
.SaveCopyAs Format(Now, "yyyymmmdd-hh""h""nn") & " " &
.Name

Else
Cancel = True
End If
End With
End If


Dim sh As Worksheet

Application.EnableCancelKey = xlDisabled

Application.ScreenUpdating = False


Sheets("accueil").Visible = xlSheetVisible 'Feuil15.Visible

For Each sh In ThisWorkbook.Sheets
sh.Protect userinterfaceonly:=True 'indispensable ??
If sh.CodeName <> "Feuil15" Then
sh.Visible = xlSheetVeryHidden
End If
Next

End Sub
'------------------------------------------------------------

JP






--
Cordialement @+
JP













Avatar
Daniel
Mets :
Application.EnableEvents = False
Avant thisworkbook.close true
Daniel
"j-pascal" a écrit dans le message de news:

Bonsoir,

J'ai mis un point d'arrêt comme tu l'as dit ...

Private Sub fermeture()
Application.EnableCancelKey = xlDisabled
On Error GoTo fin
MsgBox "Terminé !" 'jai bien le msgbox
fin:
ThisWorkbook.Close True 'surligné en jaune, et ça passe à (*)
Exit Sub '18/08 'AMHA cela ne change rien
End Sub

(*) (ThisWorkbook)

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)

Dim tst
If SaveAsUI Then 'etc... et là si l'utilisateur ne veut pas
enregistrer, l'application reste ouverte !
Par contre, ce qui est bizarre, c'est que lorsque j'exécute le code pas à
pas et que j'arrête la macro (bouton réinitialiser", après la 1ère ligne
de "Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)", le classeur se ferme !!!

Je suis un peu pessimiste ;-(

@+ ?

JP


"Daniel" a écrit dans le message de news:
OL9z$
Essaie de mettre un point d'arrêt sur msgbox et poursuis l'exécution pas
à pas.
Daniel
"j-pascal" a écrit dans le message de news:

Bonsoir,


Essaie un exit sub après le thisworkbook.close true


Sauf erreur de ma part, ça ne change rien !

Ca embraye sur : Private Sub Workbook_BeforeSave(ByVal SaveAsUI As
Boolean, Cancel As Boolean), et si je clique sur "non", le classeur
reste ouvert et je peux l'utiliser comme si de rien n'était ...

Par ailleurs, comme la macro "validité" s'exécute à l'ouverture du
classeur, on ne devrait même pas avoir de msg demandant si on veut
fermer en enregistrant ou non, puisque par définition, on a encore rien
pu faire !!

JP

Cordialement.
Daniel
"j-pascal" a écrit dans le message de news:

Bonjour,

Si dans la procédure "Validité", je ne mets pas le bon MdP, la
procédure "fermeture" est appelée et j'ai bien le message "Terminé !"
mais le classeur reste ouvert et les procédures suivantes s'enchainent
comme si de rien n'était ...

Question : pourquoi le classeur ne se ferme pas ?

Merci d'avance pour vos lumières...

'----------------------------------------------------------
Option Explicit
Dim LaDate As Date, LHeure As Date

Sub auto_open()

Dim sh As Worksheet

Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Sheets
sh.Visible = xlSheetVisible
Sheets("accueil").Visible = xlSheetVeryHidden 'ajout du
10/08
Next

For Each sh In ThisWorkbook.Sheets
sh.Protect Password:="", DrawingObjects:úlse,
Contents:=True, Scenarios:úlse, userinterfaceonly:=True
sh.EnableSelection = xlUnlockedCells
Next

Sheets("import toto").Select
ActiveSheet.Unprotect
Sheets("synth. toto").Select

Application.ScreenUpdating = True

Call Validité
Call DateEtHeure
'Call PlageRestreinte

MsgBox "Bonjour Xavier !" & Chr(10) & Chr(10) & "Nous sommes le " &
LaDate & Chr(10) & Chr(10) & "Il est " & Format(LHeure, "hh:mm"),
vbOKOnly + vbInformation, "hello"
End Sub

Sub DateEtHeure()
LaDate = Date
LHeure = Time
End Sub

Sub SDAF()
Call msg_SDAF
MsgBox "Pensez à sélectionner un onglet pour la saisie !", vbOKOnly
+ vbInformation, "rappel"
End Sub
'
'Sub PlageRestreinte()
' ActiveSheet.ScrollArea = "A1:AT110"
'End Sub

Private Sub Validité()

Dim JoursDeValidité As Integer
Dim Code As Variant
Dim réponse6 As Integer

JoursDeValidité = Range("DF2").Value

If JoursDeValidité > 0 Then
MsgBox ("Validité de l'application : " & JoursDeValidité & "
jour(s)"), vbOKOnly + vbInformation, "A noter"
Else '(date expirée)
MsgBox ("La date limite d'utilisation a expiré !"), vbOKOnly +
vbInformation, "Etat ..."
Code = InputBox("Entrez le nouveau code ...", "Prolongation
...")

If Code <> "0000" Then
réponse6 = MsgBox("Code erroné !", vbRetryCancel)
If réponse6 = vbCancel Then '(l'utilisateur annule)
Call fermeture
Else
If réponse6 = vbRetry Then '(l'utilisateur
recommence)
Code = InputBox("Entrez le nouveau code ...",
"Contactez l'auteur ...")
If Code <> "0000" Then
MsgBox "ttt"
Call fermeture
End If
End If
End If
End If
End If

ActiveSheet.Protect Password:="" '17/08/07
End Sub

Private Sub fermeture()
Application.EnableCancelKey = xlDisabled
On Error GoTo fin
MsgBox "Terminé !"
fin:
ThisWorkbook.Close True
End Sub
'---------------------------------------------------------



Et dans ThisWorkbook :
'--------------------------------------------------------
'Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)

Dim tst
If SaveAsUI Then

MsgBox "Désolé, l'option Enregistrer sous... est impossible !",
vbExclamation, "choix possibles : Enregistrer ou Fermer"

Cancel = True

Else
tst = MsgBox("Voulez-vous enregistrer une copie sous la forme :
" & "Date Heure Fichier.xls" & " ?", vbYesNo)
'& vbCrLf &

With ThisWorkbook
ChDir .Path
If tst = 6 Then
'.SaveCopyAs Format(Now, "yyyymmmdd-hhnn") & .Name
.SaveCopyAs Format(Now, "yyyymmmdd-hh""h""nn") & " " &
.Name

Else
Cancel = True
End If
End With
End If


Dim sh As Worksheet

Application.EnableCancelKey = xlDisabled

Application.ScreenUpdating = False


Sheets("accueil").Visible = xlSheetVisible 'Feuil15.Visible

For Each sh In ThisWorkbook.Sheets
sh.Protect userinterfaceonly:=True 'indispensable ??
If sh.CodeName <> "Feuil15" Then
sh.Visible = xlSheetVeryHidden
End If
Next

End Sub
'------------------------------------------------------------

JP






--
Cordialement @+
JP
















Avatar
j-pascal
On dirait que ça marche !!

Je t'avoue que je n'y croyais plus trop :o). J'ai conscience que "mes"
macros sont "un peu" alambiquées ...

Je ne suis pas sûr de comprendre comment fonctionne cette dernière
instruction ...

Un grand merci ++

JP


"Daniel" a écrit dans le message de news:
%
Mets :
Application.EnableEvents = False
Avant thisworkbook.close true
Daniel
"j-pascal" a écrit dans le message de news:

Bonsoir,

J'ai mis un point d'arrêt comme tu l'as dit ...

Private Sub fermeture()
Application.EnableCancelKey = xlDisabled
On Error GoTo fin
MsgBox "Terminé !" 'jai bien le msgbox
fin:
ThisWorkbook.Close True 'surligné en jaune, et ça passe à (*)
Exit Sub '18/08 'AMHA cela ne change rien
End Sub

(*) (ThisWorkbook)

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)

Dim tst
If SaveAsUI Then 'etc... et là si l'utilisateur ne veut pas
enregistrer, l'application reste ouverte !
Par contre, ce qui est bizarre, c'est que lorsque j'exécute le code pas à
pas et que j'arrête la macro (bouton réinitialiser", après la 1ère ligne
de "Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)", le classeur se ferme !!!

Je suis un peu pessimiste ;-(

@+ ?

JP


"Daniel" a écrit dans le message de news:
OL9z$
Essaie de mettre un point d'arrêt sur msgbox et poursuis l'exécution pas
à pas.
Daniel
"j-pascal" a écrit dans le message de news:

Bonsoir,


Essaie un exit sub après le thisworkbook.close true


Sauf erreur de ma part, ça ne change rien !

Ca embraye sur : Private Sub Workbook_BeforeSave(ByVal SaveAsUI As
Boolean, Cancel As Boolean), et si je clique sur "non", le classeur
reste ouvert et je peux l'utiliser comme si de rien n'était ...

Par ailleurs, comme la macro "validité" s'exécute à l'ouverture du
classeur, on ne devrait même pas avoir de msg demandant si on veut
fermer en enregistrant ou non, puisque par définition, on a encore rien
pu faire !!

JP

Cordialement.
Daniel
"j-pascal" a écrit dans le message de news:

Bonjour,

Si dans la procédure "Validité", je ne mets pas le bon MdP, la
procédure "fermeture" est appelée et j'ai bien le message "Terminé !"
mais le classeur reste ouvert et les procédures suivantes
s'enchainent comme si de rien n'était ...

Question : pourquoi le classeur ne se ferme pas ?

Merci d'avance pour vos lumières...

'----------------------------------------------------------
Option Explicit
Dim LaDate As Date, LHeure As Date

Sub auto_open()

Dim sh As Worksheet

Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Sheets
sh.Visible = xlSheetVisible
Sheets("accueil").Visible = xlSheetVeryHidden 'ajout du
10/08
Next

For Each sh In ThisWorkbook.Sheets
sh.Protect Password:="", DrawingObjects:úlse,
Contents:=True, Scenarios:úlse, userinterfaceonly:=True
sh.EnableSelection = xlUnlockedCells
Next

Sheets("import toto").Select
ActiveSheet.Unprotect
Sheets("synth. toto").Select

Application.ScreenUpdating = True

Call Validité
Call DateEtHeure
'Call PlageRestreinte

MsgBox "Bonjour Xavier !" & Chr(10) & Chr(10) & "Nous sommes le "
& LaDate & Chr(10) & Chr(10) & "Il est " & Format(LHeure, "hh:mm"),
vbOKOnly + vbInformation, "hello"
End Sub

Sub DateEtHeure()
LaDate = Date
LHeure = Time
End Sub

Sub SDAF()
Call msg_SDAF
MsgBox "Pensez à sélectionner un onglet pour la saisie !",
vbOKOnly + vbInformation, "rappel"
End Sub
'
'Sub PlageRestreinte()
' ActiveSheet.ScrollArea = "A1:AT110"
'End Sub

Private Sub Validité()

Dim JoursDeValidité As Integer
Dim Code As Variant
Dim réponse6 As Integer

JoursDeValidité = Range("DF2").Value

If JoursDeValidité > 0 Then
MsgBox ("Validité de l'application : " & JoursDeValidité & "
jour(s)"), vbOKOnly + vbInformation, "A noter"
Else '(date expirée)
MsgBox ("La date limite d'utilisation a expiré !"), vbOKOnly +
vbInformation, "Etat ..."
Code = InputBox("Entrez le nouveau code ...", "Prolongation
...")

If Code <> "0000" Then
réponse6 = MsgBox("Code erroné !", vbRetryCancel)
If réponse6 = vbCancel Then '(l'utilisateur annule)
Call fermeture
Else
If réponse6 = vbRetry Then '(l'utilisateur
recommence)
Code = InputBox("Entrez le nouveau code ...",
"Contactez l'auteur ...")
If Code <> "0000" Then
MsgBox "ttt"
Call fermeture
End If
End If
End If
End If
End If

ActiveSheet.Protect Password:="" '17/08/07
End Sub

Private Sub fermeture()
Application.EnableCancelKey = xlDisabled
On Error GoTo fin
MsgBox "Terminé !"
fin:
ThisWorkbook.Close True
End Sub
'---------------------------------------------------------



Et dans ThisWorkbook :
'--------------------------------------------------------
'Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)

Dim tst
If SaveAsUI Then

MsgBox "Désolé, l'option Enregistrer sous... est impossible
!", vbExclamation, "choix possibles : Enregistrer ou Fermer"

Cancel = True

Else
tst = MsgBox("Voulez-vous enregistrer une copie sous la forme
: " & "Date Heure Fichier.xls" & " ?", vbYesNo)
'& vbCrLf &

With ThisWorkbook
ChDir .Path
If tst = 6 Then
'.SaveCopyAs Format(Now, "yyyymmmdd-hhnn") & .Name
.SaveCopyAs Format(Now, "yyyymmmdd-hh""h""nn") & " " &
.Name

Else
Cancel = True
End If
End With
End If


Dim sh As Worksheet

Application.EnableCancelKey = xlDisabled

Application.ScreenUpdating = False


Sheets("accueil").Visible = xlSheetVisible 'Feuil15.Visible

For Each sh In ThisWorkbook.Sheets
sh.Protect userinterfaceonly:=True 'indispensable ??
If sh.CodeName <> "Feuil15" Then
sh.Visible = xlSheetVeryHidden
End If
Next

End Sub
'------------------------------------------------------------

JP






--
Cordialement @+
JP




















Avatar
Daniel
Bonjour.
"Application.EnableEvents = False" empêche le déclenchement de macros
évenementielles comme "Private Sub Workbook_BeforeSave"
Cordialement.
Daniel
"j-pascal" a écrit dans le message de news:

On dirait que ça marche !!

Je t'avoue que je n'y croyais plus trop :o). J'ai conscience que "mes"
macros sont "un peu" alambiquées ...

Je ne suis pas sûr de comprendre comment fonctionne cette dernière
instruction ...

Un grand merci ++

JP


"Daniel" a écrit dans le message de news:
%
Mets :
Application.EnableEvents = False
Avant thisworkbook.close true
Daniel
"j-pascal" a écrit dans le message de news:

Bonsoir,

J'ai mis un point d'arrêt comme tu l'as dit ...

Private Sub fermeture()
Application.EnableCancelKey = xlDisabled
On Error GoTo fin
MsgBox "Terminé !" 'jai bien le msgbox
fin:
ThisWorkbook.Close True 'surligné en jaune, et ça passe à (*)
Exit Sub '18/08 'AMHA cela ne change rien
End Sub

(*) (ThisWorkbook)

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)

Dim tst
If SaveAsUI Then 'etc... et là si l'utilisateur ne veut pas
enregistrer, l'application reste ouverte !
Par contre, ce qui est bizarre, c'est que lorsque j'exécute le code pas
à pas et que j'arrête la macro (bouton réinitialiser", après la 1ère
ligne de "Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean,
Cancel As Boolean)", le classeur se ferme !!!

Je suis un peu pessimiste ;-(

@+ ?

JP


"Daniel" a écrit dans le message de news:
OL9z$
Essaie de mettre un point d'arrêt sur msgbox et poursuis l'exécution
pas à pas.
Daniel
"j-pascal" a écrit dans le message de news:

Bonsoir,


Essaie un exit sub après le thisworkbook.close true


Sauf erreur de ma part, ça ne change rien !

Ca embraye sur : Private Sub Workbook_BeforeSave(ByVal SaveAsUI As
Boolean, Cancel As Boolean), et si je clique sur "non", le classeur
reste ouvert et je peux l'utiliser comme si de rien n'était ...

Par ailleurs, comme la macro "validité" s'exécute à l'ouverture du
classeur, on ne devrait même pas avoir de msg demandant si on veut
fermer en enregistrant ou non, puisque par définition, on a encore
rien pu faire !!

JP

Cordialement.
Daniel
"j-pascal" a écrit dans le message de news:

Bonjour,

Si dans la procédure "Validité", je ne mets pas le bon MdP, la
procédure "fermeture" est appelée et j'ai bien le message "Terminé
!" mais le classeur reste ouvert et les procédures suivantes
s'enchainent comme si de rien n'était ...

Question : pourquoi le classeur ne se ferme pas ?

Merci d'avance pour vos lumières...

'----------------------------------------------------------
Option Explicit
Dim LaDate As Date, LHeure As Date

Sub auto_open()

Dim sh As Worksheet

Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Sheets
sh.Visible = xlSheetVisible
Sheets("accueil").Visible = xlSheetVeryHidden 'ajout du
10/08
Next

For Each sh In ThisWorkbook.Sheets
sh.Protect Password:="", DrawingObjects:úlse,
Contents:=True, Scenarios:úlse, userinterfaceonly:=True
sh.EnableSelection = xlUnlockedCells
Next

Sheets("import toto").Select
ActiveSheet.Unprotect
Sheets("synth. toto").Select

Application.ScreenUpdating = True

Call Validité
Call DateEtHeure
'Call PlageRestreinte

MsgBox "Bonjour Xavier !" & Chr(10) & Chr(10) & "Nous sommes le "
& LaDate & Chr(10) & Chr(10) & "Il est " & Format(LHeure, "hh:mm"),
vbOKOnly + vbInformation, "hello"
End Sub

Sub DateEtHeure()
LaDate = Date
LHeure = Time
End Sub

Sub SDAF()
Call msg_SDAF
MsgBox "Pensez à sélectionner un onglet pour la saisie !",
vbOKOnly + vbInformation, "rappel"
End Sub
'
'Sub PlageRestreinte()
' ActiveSheet.ScrollArea = "A1:AT110"
'End Sub

Private Sub Validité()

Dim JoursDeValidité As Integer
Dim Code As Variant
Dim réponse6 As Integer

JoursDeValidité = Range("DF2").Value

If JoursDeValidité > 0 Then
MsgBox ("Validité de l'application : " & JoursDeValidité & "
jour(s)"), vbOKOnly + vbInformation, "A noter"
Else '(date expirée)
MsgBox ("La date limite d'utilisation a expiré !"), vbOKOnly
+ vbInformation, "Etat ..."
Code = InputBox("Entrez le nouveau code ...", "Prolongation
...")

If Code <> "0000" Then
réponse6 = MsgBox("Code erroné !", vbRetryCancel)
If réponse6 = vbCancel Then '(l'utilisateur annule)
Call fermeture
Else
If réponse6 = vbRetry Then '(l'utilisateur
recommence)
Code = InputBox("Entrez le nouveau code ...",
"Contactez l'auteur ...")
If Code <> "0000" Then
MsgBox "ttt"
Call fermeture
End If
End If
End If
End If
End If

ActiveSheet.Protect Password:="" '17/08/07
End Sub

Private Sub fermeture()
Application.EnableCancelKey = xlDisabled
On Error GoTo fin
MsgBox "Terminé !"
fin:
ThisWorkbook.Close True
End Sub
'---------------------------------------------------------



Et dans ThisWorkbook :
'--------------------------------------------------------
'Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)

Dim tst
If SaveAsUI Then

MsgBox "Désolé, l'option Enregistrer sous... est impossible
!", vbExclamation, "choix possibles : Enregistrer ou Fermer"

Cancel = True

Else
tst = MsgBox("Voulez-vous enregistrer une copie sous la forme
: " & "Date Heure Fichier.xls" & " ?", vbYesNo)
'& vbCrLf &

With ThisWorkbook
ChDir .Path
If tst = 6 Then
'.SaveCopyAs Format(Now, "yyyymmmdd-hhnn") & .Name
.SaveCopyAs Format(Now, "yyyymmmdd-hh""h""nn") & " "
& .Name

Else
Cancel = True
End If
End With
End If


Dim sh As Worksheet

Application.EnableCancelKey = xlDisabled

Application.ScreenUpdating = False


Sheets("accueil").Visible = xlSheetVisible 'Feuil15.Visible

For Each sh In ThisWorkbook.Sheets
sh.Protect userinterfaceonly:=True 'indispensable ??
If sh.CodeName <> "Feuil15" Then
sh.Visible = xlSheetVeryHidden
End If
Next

End Sub
'------------------------------------------------------------

JP






--
Cordialement @+
JP























Avatar
j-pascal
Merci !

Je vais essayer d'appliquer cela à des "Private Sub Worksheet_Change(ByVal
Target As Range)" pour accélérer mes macros ...

JP

"Daniel" a écrit dans le message de news:
%
Bonjour.
"Application.EnableEvents = False" empêche le déclenchement de macros
évenementielles comme "Private Sub Workbook_BeforeSave"
Cordialement.
Daniel
"j-pascal" a écrit dans le message de news:

On dirait que ça marche !!

Je t'avoue que je n'y croyais plus trop :o). J'ai conscience que "mes"
macros sont "un peu" alambiquées ...

Je ne suis pas sûr de comprendre comment fonctionne cette dernière
instruction ...

Un grand merci ++

JP


"Daniel" a écrit dans le message de news:
%
Mets :
Application.EnableEvents = False
Avant thisworkbook.close true
Daniel
"j-pascal" a écrit dans le message de news:

Bonsoir,

J'ai mis un point d'arrêt comme tu l'as dit ...

Private Sub fermeture()
Application.EnableCancelKey = xlDisabled
On Error GoTo fin
MsgBox "Terminé !" 'jai bien le msgbox
fin:
ThisWorkbook.Close True 'surligné en jaune, et ça passe à (*)
Exit Sub '18/08 'AMHA cela ne change rien
End Sub

(*) (ThisWorkbook)

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)

Dim tst
If SaveAsUI Then 'etc... et là si l'utilisateur ne veut pas
enregistrer, l'application reste ouverte !
Par contre, ce qui est bizarre, c'est que lorsque j'exécute le code pas
à pas et que j'arrête la macro (bouton réinitialiser", après la 1ère
ligne de "Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean,
Cancel As Boolean)", le classeur se ferme !!!

Je suis un peu pessimiste ;-(

@+ ?

JP


"Daniel" a écrit dans le message de news:
OL9z$
Essaie de mettre un point d'arrêt sur msgbox et poursuis l'exécution
pas à pas.
Daniel
"j-pascal" a écrit dans le message de news:

Bonsoir,


Essaie un exit sub après le thisworkbook.close true


Sauf erreur de ma part, ça ne change rien !

Ca embraye sur : Private Sub Workbook_BeforeSave(ByVal SaveAsUI As
Boolean, Cancel As Boolean), et si je clique sur "non", le classeur
reste ouvert et je peux l'utiliser comme si de rien n'était ...

Par ailleurs, comme la macro "validité" s'exécute à l'ouverture du
classeur, on ne devrait même pas avoir de msg demandant si on veut
fermer en enregistrant ou non, puisque par définition, on a encore
rien pu faire !!

JP

Cordialement.
Daniel
"j-pascal" a écrit dans le message de
news:
Bonjour,

Si dans la procédure "Validité", je ne mets pas le bon MdP, la
procédure "fermeture" est appelée et j'ai bien le message "Terminé
!" mais le classeur reste ouvert et les procédures suivantes
s'enchainent comme si de rien n'était ...

Question : pourquoi le classeur ne se ferme pas ?

Merci d'avance pour vos lumières...

'----------------------------------------------------------
Option Explicit
Dim LaDate As Date, LHeure As Date

Sub auto_open()

Dim sh As Worksheet

Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Sheets
sh.Visible = xlSheetVisible
Sheets("accueil").Visible = xlSheetVeryHidden 'ajout
du 10/08
Next

For Each sh In ThisWorkbook.Sheets
sh.Protect Password:="", DrawingObjects:úlse,
Contents:=True, Scenarios:úlse, userinterfaceonly:=True
sh.EnableSelection = xlUnlockedCells
Next

Sheets("import toto").Select
ActiveSheet.Unprotect
Sheets("synth. toto").Select

Application.ScreenUpdating = True

Call Validité
Call DateEtHeure
'Call PlageRestreinte

MsgBox "Bonjour Xavier !" & Chr(10) & Chr(10) & "Nous sommes le
" & LaDate & Chr(10) & Chr(10) & "Il est " & Format(LHeure,
"hh:mm"), vbOKOnly + vbInformation, "hello"
End Sub

Sub DateEtHeure()
LaDate = Date
LHeure = Time
End Sub

Sub SDAF()
Call msg_SDAF
MsgBox "Pensez à sélectionner un onglet pour la saisie !",
vbOKOnly + vbInformation, "rappel"
End Sub
'
'Sub PlageRestreinte()
' ActiveSheet.ScrollArea = "A1:AT110"
'End Sub

Private Sub Validité()

Dim JoursDeValidité As Integer
Dim Code As Variant
Dim réponse6 As Integer

JoursDeValidité = Range("DF2").Value

If JoursDeValidité > 0 Then
MsgBox ("Validité de l'application : " & JoursDeValidité & "
jour(s)"), vbOKOnly + vbInformation, "A noter"
Else '(date expirée)
MsgBox ("La date limite d'utilisation a expiré !"), vbOKOnly
+ vbInformation, "Etat ..."
Code = InputBox("Entrez le nouveau code ...", "Prolongation
...")

If Code <> "0000" Then
réponse6 = MsgBox("Code erroné !", vbRetryCancel)
If réponse6 = vbCancel Then '(l'utilisateur annule)
Call fermeture
Else
If réponse6 = vbRetry Then '(l'utilisateur
recommence)
Code = InputBox("Entrez le nouveau code ...",
"Contactez l'auteur ...")
If Code <> "0000" Then
MsgBox "ttt"
Call fermeture
End If
End If
End If
End If
End If

ActiveSheet.Protect Password:="" '17/08/07
End Sub

Private Sub fermeture()
Application.EnableCancelKey = xlDisabled
On Error GoTo fin
MsgBox "Terminé !"
fin:
ThisWorkbook.Close True
End Sub
'---------------------------------------------------------



Et dans ThisWorkbook :
'--------------------------------------------------------
'Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel
As Boolean)

Dim tst
If SaveAsUI Then

MsgBox "Désolé, l'option Enregistrer sous... est impossible
!", vbExclamation, "choix possibles : Enregistrer ou Fermer"

Cancel = True

Else
tst = MsgBox("Voulez-vous enregistrer une copie sous la
forme : " & "Date Heure Fichier.xls" & " ?", vbYesNo)
'& vbCrLf &

With ThisWorkbook
ChDir .Path
If tst = 6 Then
'.SaveCopyAs Format(Now, "yyyymmmdd-hhnn") & .Name
.SaveCopyAs Format(Now, "yyyymmmdd-hh""h""nn") & " "
& .Name

Else
Cancel = True
End If
End With
End If


Dim sh As Worksheet

Application.EnableCancelKey = xlDisabled

Application.ScreenUpdating = False


Sheets("accueil").Visible = xlSheetVisible 'Feuil15.Visible

For Each sh In ThisWorkbook.Sheets
sh.Protect userinterfaceonly:=True 'indispensable ??
If sh.CodeName <> "Feuil15" Then
sh.Visible = xlSheetVeryHidden
End If
Next

End Sub
'------------------------------------------------------------

JP






--
Cordialement @+
JP



























Avatar
R1
j-pascal wrote:

Par ailleurs, comme la macro "validité" s'exécute à l'ouverture du
classeur, on ne devrait même pas avoir de msg demandant si on veut fermer
en enregistrant ou non, puisque par définition, on a encore rien pu faire
!!
Sauf qu'à l'ouverture de document, il peut y avoir des recalculs

automatiques de cellules. Sont-ils faits avant ou après Validité(), là
serait la question.

JP
R1


Avatar
j-pascal
Bonjour,

Effectivement ! Merci pour cette remarque !
La suggestion de Daniel étant efficace, je m'en tiens là pour l'instant,
mais je vais regarder ça de plus près dans les jours qui viennent ...

PS : le pb, c'est qu'à une réponse à mes questions, je me pose 10 nouvelles
questions !! ;-)

JP


"R1" a écrit dans le message de news:

j-pascal wrote:

Par ailleurs, comme la macro "validité" s'exécute à l'ouverture du
classeur, on ne devrait même pas avoir de msg demandant si on veut fermer
en enregistrant ou non, puisque par définition, on a encore rien pu faire
!!
Sauf qu'à l'ouverture de document, il peut y avoir des recalculs

automatiques de cellules. Sont-ils faits avant ou après Validité(), là
serait la question.

JP
R1