Quitter l'application Excel automatiquement

Bonjour à tous,
Je suis en train de réaliser une macro en VBA sous Excel. L'objectif de cette dernière est de sauvegarder, fermer la feuille Excel mais aussi l'application. Tout fonctionne sauf que l'application ne se ferme pas.

Voici mon code :
Dans un module :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Public HeureArrêt
Sub ProchainArret()
 HeureArrêt = Now + TimeValue("00:10:10")
 Application.OnTime HeureArrêt, "Fin"
 Sheets(1).[A1] = HeureArrêt
End Sub
 
Sub Fin()
  On Error Resume Next
  Application.OnTime HeureArrêt, Procedure:="Fin", Schedule:=False    'annule événnement
  ThisWorkbook.Close True
  Application.Quit
End Sub

Dans ThisWorkbook :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Sub Workbook_Open()
 ProchainArret
End Sub
 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
 On Error Resume Next
 Application.OnTime HeureArrêt, Procedure:="Fin", Schedule:=False
 ProchainArret
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
  ThisWorkbook.Save
  'ThisWorkbook.Saved = True
  On Error Resume Next
  Application.OnTime HeureArrêt, Procedure:="Fin", Schedule:=False  ' annule événnement
End Sub