(vba) sortie de procédure ...

Le
j-pascal
Bonjour,

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

Question : pourquoi le classeur ne se ferme pas ?

Merci d'avance pour vos lumières

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

Sub auto_open()

Dim sh As Worksheet

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

For Each sh In ThisWorkbook.Sheets
sh.Protect Password:="", DrawingObjects:ú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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Daniel
Le #4660731
Bonjour.
Essaie un exit sub après le thisworkbook.close true
Cordialement.
Daniel
"j-pascal"
Bonjour,

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

Question : pourquoi le classeur ne se ferme pas ?

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

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

Sub auto_open()

Dim sh As Worksheet

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

For Each sh In ThisWorkbook.Sheets
sh.Protect Password:="", DrawingObjects:ú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


j-pascal
Le #4660681
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"
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






Daniel
Le #4660651
Essaie de mettre un point d'arrêt sur msgbox et poursuis l'exécution pas à
pas.
Daniel
"j-pascal"
Bonsoir,


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


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

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

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

JP

Cordialement.
Daniel
"j-pascal"
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









j-pascal
Le #4660481
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" OL9z$
Essaie de mettre un point d'arrêt sur msgbox et poursuis l'exécution pas à
pas.
Daniel
"j-pascal"
Bonsoir,


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


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

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

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

JP

Cordialement.
Daniel
"j-pascal"
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













Daniel
Le #4660361
Mets :
Application.EnableEvents = False
Avant thisworkbook.close true
Daniel
"j-pascal"
Bonsoir,

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

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

(*) (ThisWorkbook)

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

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

Je suis un peu pessimiste ;-(

@+ ?

JP


"Daniel" OL9z$
Essaie de mettre un point d'arrêt sur msgbox et poursuis l'exécution pas
à pas.
Daniel
"j-pascal"
Bonsoir,


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


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

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

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

JP

Cordialement.
Daniel
"j-pascal"
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
















j-pascal
Le #4660311
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" %
Mets :
Application.EnableEvents = False
Avant thisworkbook.close true
Daniel
"j-pascal"
Bonsoir,

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

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

(*) (ThisWorkbook)

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

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

Je suis un peu pessimiste ;-(

@+ ?

JP


"Daniel" OL9z$
Essaie de mettre un point d'arrêt sur msgbox et poursuis l'exécution pas
à pas.
Daniel
"j-pascal"
Bonsoir,


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


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

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

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

JP

Cordialement.
Daniel
"j-pascal"
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




















Daniel
Le #4660181
Bonjour.
"Application.EnableEvents = False" empêche le déclenchement de macros
évenementielles comme "Private Sub Workbook_BeforeSave"
Cordialement.
Daniel
"j-pascal"
On dirait que ça marche !!

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

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

Un grand merci ++

JP


"Daniel" %
Mets :
Application.EnableEvents = False
Avant thisworkbook.close true
Daniel
"j-pascal"
Bonsoir,

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

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

(*) (ThisWorkbook)

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

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

Je suis un peu pessimiste ;-(

@+ ?

JP


"Daniel" OL9z$
Essaie de mettre un point d'arrêt sur msgbox et poursuis l'exécution
pas à pas.
Daniel
"j-pascal"
Bonsoir,


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


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

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

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

JP

Cordialement.
Daniel
"j-pascal"
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























j-pascal
Le #4660111
Merci !

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

JP

"Daniel" %
Bonjour.
"Application.EnableEvents = False" empêche le déclenchement de macros
évenementielles comme "Private Sub Workbook_BeforeSave"
Cordialement.
Daniel
"j-pascal"
On dirait que ça marche !!

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

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

Un grand merci ++

JP


"Daniel" %
Mets :
Application.EnableEvents = False
Avant thisworkbook.close true
Daniel
"j-pascal"
Bonsoir,

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

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

(*) (ThisWorkbook)

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

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

Je suis un peu pessimiste ;-(

@+ ?

JP


"Daniel" OL9z$
Essaie de mettre un point d'arrêt sur msgbox et poursuis l'exécution
pas à pas.
Daniel
"j-pascal"
Bonsoir,


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


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

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

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

JP

Cordialement.
Daniel
"j-pascal" 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



























R1
Le #4660041
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
Le #4803381
Bonjour,

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

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

JP


"R1"
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




Publicité
Poster une réponse
Anonyme