Microsoft 365 Sauvegarder et fermer le fichier et + application si c'est le dernier fichier à fermer

    RétabliMenu
    Application.EnableEvents = True
    With ThisWorkbook
        Application.DisplayAlerts = False
        ActiveWorkbook.Save
        If Workbooks.Count = 1 Then Application.Quit Else .Close
    End With

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Static flag As Boolean
If flag Then Exit Sub
Application.EnableEvents = False
'---
Me.Save
Application.EnableEvents = True
flag = True
If Workbooks.Count = 1 Then Application.Quit Else Me.Close
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Static flag As Boolean
    If flag Then Exit Sub
    Application.EnableEvents = False
    
    If ActiveSheet.Range("i7") = "ICI" Then
    Application.EnableEvents = False
    MsgBox ("Affecter avant de quitter")
    UsFMsg4.Show
    Cancel = True
    Application.EnableEvents = True
    Exit Sub
    End If
    
    If Sheets("SMS RdV").Range("c27") <> "" Then
    Application.EnableEvents = False
    MsgBox ("envoi SMS avant de quitter")
    Sheets("SMS RdV").Select
    Cancel = True
    Application.EnableEvents = True
    Exit Sub
    End If

    dl = Sheets("RdV_transfert").Range("A" & Rows.Count).End(xlUp).Row
    If Sheets("RdV_transfert").Cells(dl, 4) = "" Then
    Application.EnableEvents = False
    MsgBox ("mettre l'agenda Client à jour du dernier RdV")
    Sheets("RdV_transfert").Select
    Cancel = True
    Application.EnableEvents = True
    Exit Sub
    End If
    
   If Sheets("Appels").Range("n1") = 1 Then
    Application.EnableEvents = False
    Sheets("Appels").Select
    MsgBox ("N° cliqué NON affecté : Normal Dr ?" & Chr(10) & "Affecter ou clic X pour annuler")
    Cancel = True
    ActiveSheet.Unprotect Password:=""
        Columns("N:N").Select
        Selection.Find(What:="x", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
        Application.EnableEvents = True
        ActiveCell.Offset(0, -3).Select
    Exit Sub
    End If
    
    Sheets("Appels").Select
    Sheets("Appels").Unprotect Password:=""
    Sheets("Appels").Range("m1") = "TEXTBOX FERME"
        With Sheets("Appels").Range("m1").Interior
        .Color = RGB(55, 86, 35)
        End With
    Sheets("Appels").Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
    With Sheets("Appels")
        .TextBox1.Visible = False
    End With
    'Selection.AutoFilter 'ôte le filtre
    Application.OnKey "%{F8}"
    RétabliMenu
    
    Me.Save
    Application.EnableEvents = True
    flag = True
    If Workbooks.Count = 1 Then Application.Quit Else Me.Close
    End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    'sauvegarde de sécurité
'    On Error Resume Next
'    Application.OnTime t, "Enregistrer", , False 'arrête le processus
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    ActiveWindow.DisplayGridlines = False
    
    Application.Calculation = xlAutomatic
    If ActiveSheet.Name = "SaisieRdV" Then
    If [aa8] <> 19 Then
    MsgBox ("Avant de quitter, traitez votre RdV en cours !")
    Cancel = True
    activeMacros_SaisieRdV
    Exit Sub
    End If
    End If
    
    Sheets("SuivisAppels").Select
    If [t3] <> "OK" Then
     Blocage
     Cancel = True
     Application.ScreenUpdating = False
     Exit Sub
    Else
    ActiveWindow.DisplayHorizontalScrollBar = True
        ActiveWindow.DisplayVerticalScrollBar = True
            Application.DisplayFormulaBar = True
                Application.ScreenUpdating = False
                    Application.EnableEvents = False
                        Application.Calculation = xlManual
    
    Sheets("SuivisAppels").Unprotect Password:="Krameri"
    Sheets("SuivisAppels").Range("a3") = 1
    Sheets("SuivisAppels").Protect Password:="Krameri", DrawingObjects:=True, Contents:=True, Scenarios:=True
    
    Sheets("ArguVendeurs").Unprotect Password:="Krameri"
    Sheets("ArguVendeurs").Range("a1") = 1
    Sheets("ArguVendeurs").Protect Password:="Krameri", DrawingObjects:=True, Contents:=True, Scenarios:=True
    End If
    Application.ScreenUpdating = False
    Sheets("SuivisAppels").Unprotect Password:="Krameri"
'        Dim DL As Long 'Définition de la variable
'        DL = Cells(Application.Rows.Count, 1).End(xlUp).Row 'Je définis la dernière ligne dont la colonne A n'est pas vide
        Range("ac1").Copy
        'Range("ac7:ac20000").Select
        
        Range([ac2], Cells(Rows.Count, "ac").End(xlUp)).Select
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Trie_Ttlignes 'SupprFormats
        
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        On Error Resume Next
        Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        
        [a3] = 1 'si 2 ne redimentionne pas l'affichage
        [a6].Select
    
    If [t3] = "OK" Then
    RétabliMenu2
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    affichage_normal2
    Application.ScreenUpdating = False
    ActiveWindow.DisplayHeadings = True
     With Application
    .MoveAfterReturn = True
    .MoveAfterReturnDirection = xlToRight
    Application.MoveAfterReturnDirection = xlToRight
    End With
        ActiveWorkbook.Save
        ActiveWorkbook.RunAutoMacros Which:=xlAutoClose
    Else
    CreateObject("Wscript.shell").Popup "Manque infos ou OK !", 1, "Oups"
        Cancel = True
    Application.ScreenUpdating = False
    Range([y7], Cells(Rows.Count, "y").End(xlUp)).Select
    'Columns("y:y").Select
    Selection.Find(What:="1", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Offset(0, -7).Activate
    ActiveWindow.ScrollRow = Selection.Row
    End If
    Sheets("ClientsCoordonnées").Visible = False
    ActiveWindow.LargeScroll ToRight:=-1
    'Sheets("A Faire").Select
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlAutomatic
    'Sheets("A Faire").Select
    
    Application.EnableEvents = True
    CODE CP4
   With ThisWorkbook
        Application.DisplayAlerts = False
        ActiveWorkbook.Save
        If Workbooks.Count = 1 Then Application.Quit Else .Close
        Application.DisplayAlerts = True
    End With
    End Sub