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

[Usine à gaz]

Bonjour à toutes et à tous,
Je vous souhaite une beau dimanche

J'ai un p'tit code pour enregistrer mon fichier à la fermeture et tout fermer (fichier + application) :

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ActiveWorkbook.Save
    ActiveWorkbook.RunAutoMacros Which:=xlAutoClose
End Sub

Jusqu'à maintenant, nous avions toujours un seul fichier Excel ouvert, donc pas de souci.

Pour les nouveaux besoins de notre travail, nous allons avoir 2 voire plus de fichiers ouverts en même temps.
Je cherche le bon code qui permettrait :
- de sauvegarder le fichier que l'on veut fermer et le fermer,
- Et de ne fermer l'application que si c'est le dernier fichier ouvert que nous fermons,

J'ai fait des recherches et tentatives mais je n'ai pas trouvé.
Auriez-vous le bon code ?

Je vous remercie (comme toujours) et je continue mes recherches.
Amicalement,
lionel

 

[cp4]

Bonjour @Usine à gaz,

Normalement, ceci devrait faire l'affaire

With ThisWorkbook
        .Save
        If Workbooks.Count = 1 Then Application.Quit Else .Close
End With

Bon dimanche.

 

[Usine à gaz]

Bonjour cp4
Tu es plus rapide que l'éclair
Je te remercie.
Je teste et je reviens te dire ce que ça fait chez moi.
lionel

 

[Usine à gaz]

Re
Y'veut pas :

J'ai également tenté avec "ActiveWorkbook.Save"
lionel

 

[cp4]

Montre-nous ton code, stp

 

[Usine à gaz]

Voici tout le code :

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    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
'    ActiveWorkbook.Save
'    ActiveWorkbook.RunAutoMacros Which:=xlAutoClose
    .Save
        If Workbooks.Count = 1 Then Application.Quit Else .Close
End Sub

 

[cp4]

En retour, tu as supprimé With Thisworkbook .......... End with. Du coup, ça plante.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    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

    With ThisWorkbook
        .Save
        If Workbooks.Count = 1 Then Application.Quit Else .Close
    End With
End Sub

 

[Usine à gaz]

Merci à toi

With ThisWorkbook
        .Save
        If Workbooks.Count = 1 Then Application.Quit Else .Close
End With

ça fonctionne.
Juste petit souci, ça me désactive les macros pour les fichiers restants ouverts.
lionel,

 

[cp4]

Merci à toi

With ThisWorkbook
        .Save
        If Workbooks.Count = 1 Then Application.Quit Else .Close
End With

ça fonctionne.
Juste petit souci, ça me désactive les macros pour les fichiers restants ouverts.
lionel,

, là je ne comprends pas. Si ton fichier se ferme, ses macros aussi ne fonctionneront pas, normal!
J'utilise ce code, mais je n'ai jamais remarqué ce que tu dis sur les autres fichiers ouverts.

 

[Usine à gaz]

Bizarre ????
je ne sais pas non plus pourquoi.
Je cherche et si je trouve je reviendrai pour te dire.
lionel

 

[cp4]

Je viens de tester le code utilisé dans l'un de mes fichiers. Comme tu peux le constater sur la démo. mon fichier se ferme, mais pas le second dans lequel ses macros restent fonctionnelles.

 

[Usine à gaz]

Je vois
Mais je crois que j'ai trouvé, ça vient de chez moi
Je reviens dès que j'ai trouvé

 

[Usine à gaz]

Grrr ! et Grrr !

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

C'est la macro "RétabliMenu" qui, pour mes autres besoins désactive les codes.
J'ai donc ajouté " Application.EnableEvents = True

Mais maintenant, il ne "save" plus automatiquement Grrrrr !!!!

Sauf si c'est le dernier fichier que je ferme.
J'va devenir "bourrique" lol

 

[cp4]

Rajoute Application.DisplayAlerts = False
que tu remettras à en fin de procédure à True

 

[Usine à gaz]

OK, je fais ça, merci à toi