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
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
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
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
Essaie un exit sub après le thisworkbook.close true
Cordialement.
Daniel
"j-pascal" <nospam-j-pascal@free.fr> a écrit dans le message de news:
OKsUgjZ4HHA.4476@TK2MSFTNGP06.phx.gbl...
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
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
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
!!
JPCordialement.
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
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" <nospam-j-pascal@free.fr> a écrit dans le message de news:
OKsUgjZ4HHA.4476@TK2MSFTNGP06.phx.gbl...
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
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
!!
JPCordialement.
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
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
!!
JPCordialement.
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
Essaie de mettre un point d'arrêt sur msgbox et poursuis l'exécution pas à
pas.
Daniel
"j-pascal" <nospam-j-pascal@free.fr> a écrit dans le message de news:
etjpJQc4HHA.4436@TK2MSFTNGP03.phx.gbl...
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" <nospam-j-pascal@free.fr> a écrit dans le message de news:
OKsUgjZ4HHA.4476@TK2MSFTNGP06.phx.gbl...
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
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
!!
JPCordialement.
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
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 !!
JPCordialement.
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
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" <dZZZcolardelle@free.fr> a écrit dans le message de news:
OL9z$Yc4HHA.4712@TK2MSFTNGP04.phx.gbl...
Essaie de mettre un point d'arrêt sur msgbox et poursuis l'exécution pas
à pas.
Daniel
"j-pascal" <nospam-j-pascal@free.fr> a écrit dans le message de news:
etjpJQc4HHA.4436@TK2MSFTNGP03.phx.gbl...
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" <nospam-j-pascal@free.fr> a écrit dans le message de news:
OKsUgjZ4HHA.4476@TK2MSFTNGP06.phx.gbl...
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
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 !!
JPCordialement.
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
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 !!
JPCordialement.
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
Mets :
Application.EnableEvents = False
Avant thisworkbook.close true
Daniel
"j-pascal" <nospam-j-pascal@free.fr> a écrit dans le message de news:
ud7viMd4HHA.2208@TK2MSFTNGP06.phx.gbl...
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" <dZZZcolardelle@free.fr> a écrit dans le message de news:
OL9z$Yc4HHA.4712@TK2MSFTNGP04.phx.gbl...
Essaie de mettre un point d'arrêt sur msgbox et poursuis l'exécution pas
à pas.
Daniel
"j-pascal" <nospam-j-pascal@free.fr> a écrit dans le message de news:
etjpJQc4HHA.4436@TK2MSFTNGP03.phx.gbl...
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" <nospam-j-pascal@free.fr> a écrit dans le message de news:
OKsUgjZ4HHA.4476@TK2MSFTNGP06.phx.gbl...
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
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 !!
JPCordialement.
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
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 !!
JPCordialement.
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
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" <dZZZcolardelle@free.fr> a écrit dans le message de news:
%23SqNtvd4HHA.2208@TK2MSFTNGP06.phx.gbl...
Mets :
Application.EnableEvents = False
Avant thisworkbook.close true
Daniel
"j-pascal" <nospam-j-pascal@free.fr> a écrit dans le message de news:
ud7viMd4HHA.2208@TK2MSFTNGP06.phx.gbl...
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" <dZZZcolardelle@free.fr> a écrit dans le message de news:
OL9z$Yc4HHA.4712@TK2MSFTNGP04.phx.gbl...
Essaie de mettre un point d'arrêt sur msgbox et poursuis l'exécution
pas à pas.
Daniel
"j-pascal" <nospam-j-pascal@free.fr> a écrit dans le message de news:
etjpJQc4HHA.4436@TK2MSFTNGP03.phx.gbl...
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" <nospam-j-pascal@free.fr> a écrit dans le message de news:
OKsUgjZ4HHA.4476@TK2MSFTNGP06.phx.gbl...
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
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 !!
JPCordialement.
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
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 !!
JPCordialement.
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
Bonjour.
"Application.EnableEvents = False" empêche le déclenchement de macros
évenementielles comme "Private Sub Workbook_BeforeSave"
Cordialement.
Daniel
"j-pascal" <nospam-j-pascal@free.fr> a écrit dans le message de news:
Okfmcie4HHA.4584@TK2MSFTNGP03.phx.gbl...
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" <dZZZcolardelle@free.fr> a écrit dans le message de news:
%23SqNtvd4HHA.2208@TK2MSFTNGP06.phx.gbl...
Mets :
Application.EnableEvents = False
Avant thisworkbook.close true
Daniel
"j-pascal" <nospam-j-pascal@free.fr> a écrit dans le message de news:
ud7viMd4HHA.2208@TK2MSFTNGP06.phx.gbl...
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" <dZZZcolardelle@free.fr> a écrit dans le message de news:
OL9z$Yc4HHA.4712@TK2MSFTNGP04.phx.gbl...
Essaie de mettre un point d'arrêt sur msgbox et poursuis l'exécution
pas à pas.
Daniel
"j-pascal" <nospam-j-pascal@free.fr> a écrit dans le message de news:
etjpJQc4HHA.4436@TK2MSFTNGP03.phx.gbl...
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" <nospam-j-pascal@free.fr> a écrit dans le message de
news: OKsUgjZ4HHA.4476@TK2MSFTNGP06.phx.gbl...
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
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 !!
JPCordialement.
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
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
JP
R1
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
JP
R1
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
JP
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
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
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