Discussion :

[jpma75]

Bonjour,

Je me perds dans les événements Save, Close et surtout dans leur chronologie.

L'idée est que le classeur se ferme sur demande ou avec temporisation.
Sur commande, ce message apparaît à la fermeture : "Excel a cessé de fonctionné" (ce qui m'inquiète !) "Veuillez patienter pendant qu'Excel redémarre".
Il y a donc un gros bug et je tourne en rond même en mettant des "Stop" partout pour essayer de comprendre où ça coince.

Dans ThisWorkbook :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
 
Option Explicit
Private Sub Workbook_Open()
    témoin = False  'fermeture
    'blabla
    témoin = True
    Call TimeSetting
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If témoin = False Then Exit Sub
   Call TimeSetting
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Stop
    On Error Resume Next
    Application.OnTime EarliestTime:=CloseTime, Procedure:="SavedAndClose", Schedule:=False
'    Application.DisplayAlerts = False
'    ThisWorkbook.Save
'    Application.DisplayAlerts = True
End Sub
Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Stop
    If témoin = False Then GoTo Fin
 
    If SaveAsUI Then
        MsgBox "Désolé, l'option Enregistrer sous... est impossible !", _
            vbExclamation, " Veuillez utiliser Fichier / Fermer "
        Cancel = True
    Else
        Call Options_Enregistrement
    End If
 
Fin:
    If Application.Workbooks.Count = 1 Then
'        Application.DisplayAlerts = False
'        ThisWorkbook.Save
'        Application.DisplayAlerts = True
        Application.Quit
    Else
        Application.ActiveWindow.Close
    End If
End Sub

Dans Module standard :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Option Explicit
Option Private Module
Public témoin As Byte
Public CloseTime As Date
Sub TimeSetting(Optional kSec As Integer = 60)
 
    If témoin = False Then Exit Sub
    On Error Resume Next
 
    Application.OnTime EarliestTime:=CloseTime, Procedure:="SavedAndClose", Schedule:=False
    CloseTime = DateAdd("s", kSec, Now)
    Application.OnTime EarliestTime:=CloseTime, Procedure:="SavedAndClose", Schedule:=True
End Sub
Sub SavedAndClose()
 
    If UserForm1.Visible Then
        Call Options_Enregistrement
    Else
        UserForm1.Show
    End If
End Sub

Dans Module Feuilles (UF) :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Option Explicit
Private Sub UserForm_Activate()
    TimeSetting 10
    AfficherSecondes
End Sub
Sub AfficherSecondes()
    Dim i As Integer, n As Single
    n = (CloseTime - Now) * 24 * 3600
    For i = n To 1 Step -1
        Me.LabelTime = i
        Application.Wait (Now + TimeValue("00:00:01"))
        DoEvents
        On Error GoTo Fin   'si clic sur Fermer > Erreur
        If Me.Visible = False Then Exit For
    Next i
Fin:
End Sub
Private Sub btnReprendre_Click()
    TimeSetting
    Me.Hide
End Sub

Dans Module standard :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Option Explicit
Option Private Module
Dim Répertoire As String, Fichier As String, FichierIndexé As String
Sub Options_Enregistrement()
Dim Sh As Worksheet
Stop
    Call Test_Rép
 
    ThisWorkbook.Unprotect "xx"
 
    With Sheets("accueil")
        .Visible = True
        ActiveWindow.ScrollRow = 1
        ActiveWindow.ScrollColumn = 1
    End With
 
    For Each Sh In ThisWorkbook.Sheets
        If Sh.CodeName <> "Feuil01" Then Sh.Visible = xlSheetVeryHidden
    Next
 
    ThisWorkbook.Protect "xx", True, True
 
    ThisWorkbook.SaveCopyAs Répertoire & "\" & FichierIndexé  
 
    témoin = False 'attention !!
    ThisWorkbook.Close vbYes
 
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub Test_Rép()
 
    Fichier = ThisWorkbook.Name
    FichierIndexé = Format(Now, "yyyymmdd-hh""h""nn") & " " & Fichier
 
    If ExistenceRépertoire("S:\Sauvegardes") = True Then
        Répertoire = "S:\Sauvegardes"
    Else
        MsgBox "Le répertoire de Sauvegardes a été déplacé ou supprimé !", vbInformation, "Alerte"
        Répertoire = ThisWorkbook.Path
    End If
End Sub

En vous remerciant par avance pour votre aide,
Cdt

[Qwazerty]

Salut

Je n'ai pas lu tout le code mais quelques remarques

Il vaut mieux éviter les caractère accentué dans les nom de variables
Attention avec les "On error resume next", quand le code plante sur une ligne... il passe à la ligne suivante et on ne vois aucun message d'erreur... dur dur de dépanner. Je sais qu'il est compliqué de faire des gestion d'erreur (il y a des tuto" mais à minima il faut mettre en commentaire les "on error ..." le temps de dépanner le fichier.

Dans le code à proprement parlé

BeforeClose est appelé au moment où on clique sur la croix de la fenêtre ou quand on appel Close, ou tout autre opération qui vise à fermer le classeur/Excel. Quand l’exécution passe End Sub, tout se ferme.
Du coup il y a un hiatus je pense, puisque tu lances un procédure en attente... sauf que quand le timeur arrive au bout Excel est déjà sensé être fermé...
Il faut utiliser Cancel, il suffit de passer Cancel à 1 pour annuler la fermeture mais attention, il faudra prévoir une variable globale pour signaler que cette fois il ne faut pas annuler.

En gros
1/L'utilisateur ferme Excel
2/BeforeClose est appelé
3/Tu contrôle la valeur d'une variable global OnFerme, par défaut elle est à False
4/Tu programmes l'exécution d'un code de fermeture temporisé
5/Tu annules la fermeture.
....
6/Au bout de la tempo, tu passe la variable OnFerme à True et tu demande la fermeture
7/BeforeClose est appelé
8/Tu contrôle la valeur d'une variable global OnFerme, cette fois, elle est à true, tu laisses filer

ça donnerait un truc comme ça pour BeforeClose

Code :

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

1
2
3
4
5
6
7
8
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
 
   if not OnFerme then
       Application.OnTime EarliestTime:=CloseTime, Procedure:="SavedAndClose", Schedule:=False
       Cancel = 1
   end if
End Sub

[jpma75]

Bonjour,

Merci pour ton aide que je vais regarder avec soin (j'ai déjà modifié mon code initial par petites touches - de manière insatisfaisante - depuis mon post sur le forum...)

tu lances un procédure en attente... sauf que quand le timeur arrive au bout Excel est déjà sensé être fermé...

Je sentais bien un problème de ce côté là et ta suggestion par rapport à Cancel me parle.

Merci pour les conseils concernant On Error Resume Next (sachant que ce n'est "idéal", il m'arrive parfois de faire mieux) ; pour les caractères accentués, je sais là encore que ce n'est pas top mais je n'ai jamais rencontré de problème(s) ce qui rend toujours plus dur l'application d'une recommandation.

A bientôt pour retour d'expérience !
Bonne année !