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

Usine à gaz · 12 Décembre 2021

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) :

VB:

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 · 12 Décembre 2021

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

cp4 · 12 Décembre 2021

Bonjour @Usine à gaz,

Normalement, ceci devrait faire l'affaire

VB:

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

Bon dimanche.

Usine à gaz · 12 Décembre 2021

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 · 12 Décembre 2021

Re
Y'veut pas :

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

cp4 · 12 Décembre 2021

Montre-nous ton code, stp

Usine à gaz · 12 Décembre 2021

Voici tout le code :

VB:

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 · 12 Décembre 2021

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

VB:

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 · 12 Décembre 2021

Merci à toi

VB:

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 · 12 Décembre 2021

Usine à gaz à dit:
Merci à toi

VB:

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 · 12 Décembre 2021

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

cp4 · 12 Décembre 2021

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 · 12 Décembre 2021

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

Usine à gaz · 12 Décembre 2021

Grrr ! et Grrr !

VB:

 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 · 12 Décembre 2021

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

Usine à gaz · 12 Décembre 2021

OK, je fais ça, merci à toi

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

Usine à gaz

XLDnaute Barbatruc

cp4

cp4

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

cp4

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

cp4

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

cp4

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

cp4

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

cp4

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Discussions similaires