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