XL 2016 [RESOLU] Excel toujours actif malgré Application.Quit

Sub DeleteChartInactiveSheets()

On Error Resume Next

'La présentation est ouverte et la référence Microsoft Excel Object Library est activée

'DEFINITION DES VARIABLES

'Variables de boucles
Dim i As Integer 'Index de diapositive dans la présentation active
Dim j As Integer 'Index de forme dans la diapositive active
Dim k As Integer 'Index de forme dans le groupe de formes actif

'Boite de dialogue pour confirmer ou infirmer l'exécution de la macro-commande
If MsgBox("Souhaitez-vous supprimer toutes les feuilles de calcul inactives ?", vbYesNo) = vbYes Then
'Si oui, alors suite de la procédure
Else
    Exit Sub 'Si non, alors fin de la procédure
End If

'Désactivation des alertes Powerpoint pour fluidifier le déroulement
Application.DisplayAlerts = ppAlertsNone

    'DEBUT DE L'ACTION DANS MICROSOFT POWERPOINT

'Boucle dans toutes les diapositives de la présentation active
For i = 1 To ActivePresentation.Slides.Count
    'Boucle dans toutes les formes de la diapositive
    For j = 1 To ActivePresentation.Slides(i).Shapes.Count
      
        'Vérification de la présence d'un graphique
        If ActivePresentation.Slides(i).Shapes(j).HasChart Then
            'Si graphique présent: Appel de la sous-procédure qui supprimera les feuilles inactives
            SupprExcelShts ActivePresentation.Slides(i).Shapes(j)
      
        'Si pas de graphique identifié, on s'assure qu'il n'est pas "caché" dans un groupe de formes
        'Vérification de la présence d'un groupe de formes
        ElseIf ActivePresentation.Slides(i).Shapes(j).Type = msoGroup Then
            'Boucle dans toutes les formes du groupe de formes
            For k = 1 To ActivePresentation.Slides(i).Shapes(j).GroupItems.Count
                If ActivePresentation.Slides(i).Shapes(j).GroupItems.Item(k).HasChart Then
                'Si l'une des formes du groupe est un graphique, alors appel de la sous-procédure
                    SupprExcelShts ActivePresentation.Slides(i).Shapes(j).GroupItems.Item(k)
                End If
            Next k
        End If
              
    Next j
Next i
  
'Rétablissement des alertes Powerpoint
Application.DisplayAlerts = ppAlertsAll

'Boite de dialogue pour annoncer la fin du programme
MsgBox "La suppression des feuilles de calcul" & vbNewLine & "inactives est terminée."

End Sub

'Sous-procédure servant à supprimer les feuilles de calcul inactives
Private Sub SupprExcelShts(shp As Shape)

'DEFINITION DES VARIABLES

'Variables globales
Dim pptChart As Chart
Dim pptChartData As ChartData
Dim Excl As New Excel.Application
Dim pptWorkbook As Workbook

'Variables de boucles
Dim sh As Worksheet
Dim graphsh As Excel.Chart
Dim i As Integer

'Définitions des objets graphiques et séries de données pour la forme active
Set pptChart = shp.Chart
Set pptChartData = pptChart.ChartData

'Ouverture de la feuille de calcul contenant les données
pptChartData.Activate
'Suspend la macro jusqu'à ouverture complète de l'onglet
DoEvents

'PARTIE DANS MICROSOFT EXCEL SI GRAPHIQUE IDENTIFIE

'Définition des objets Excel pour le graphique Powerpoint actif
Set pptWorkbook = pptChartData.Workbook
Set Excl = pptWorkbook.Application

'Désactivation des alertes Excel pour fluidifier le déroulement
Excl.Application.DisplayAlerts = False

    'Boucle dans toutes les feuilles de calcul du classeur
    For Each sh In Sheets
        'Identifie les feuilles à supprimer par leurs noms
        If sh.Name <> ActiveSheet.Name Then
            sh.Delete 'Supprime la feuille si nom différent
        End If
    Next sh
  
    'Boucle dans toutes les feuilles graphique du classeur
    For Each graphsh In Charts
        'Identifie les feuilles à supprimer par leurs noms
        If graphsh.Name <> ActiveSheet.Name Then
                graphsh.Delete 'Supprime la feuille si nom différent
        End If
    Next graphsh
  
'REINITIALISATION DE LA POSITION DU CURSEUR PUIS FERMETURE

'Cellule A1 sélectionnée
ActiveSheet.Cells(1, 1).Select
'Rétablissement des alertes Excel
pptWorkbook.Application.DisplayAlerts = True
'Fermeture de la feuille de calcul
pptWorkbook.Close
'Fermeture de l'application Excel
Excl.Quit
'Suspend la macro jusqu'à fermeture
DoEvents

'Réinitialisation de toutes les variables objets
Set pptWorkbook = Nothing
Set Excl = Nothing
Set pptChartData = Nothing
Set pptChart = Nothing

'Fin de la sous-procédure, retour à la procédure principale et à Powerpoint
End Sub