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

[Brain Box]

Bonjour à tous

En ces périodes de grand froid j'ai eu un peu de temps pour me consacrer à VBA, et dernièrement je suis tombé sur un os (que je partage avec vous !).

La macro en question (disponible ci-dessous) se lance depuis Powerpoint, boucle sur les graphiques pour les "nettoyer" de feuilles inactives qui sont parfois importées lors d'opérations de copier-coller. C'est un outil qui permet d'éviter les fichiers trop volumineux, qui ne passent pas par mail ! Le code fonctionne au demeurant, mais uniquement lorsque le volume à traiter est raisonnable --> la mémoire sature au bout d'un moment, ce qui cause un plantage.

La raison est assez simple : à chaque nouveau graphique une instance Excel est créée, mais n'est pas totalement fermée malgré la présence d'un "Application.Quit" dans ma boucle sensée régler le problème.
Ces sujets sont abordés régulièrement --> https://www.excel-downloads.com/threads/une-erreur-qui-nen-est-pas-une.20012270/#post-20092607 ; https://www.excel-downloads.com/threads/problème-référencement-excel-vb6.185444/#post-1147658 ; https://www.excel-downloads.com/threads/fermer-excel-exe-complètement.129589/ .... voir même en anglais https://stackoverflow.com/questions...ode-still-running-in-the-process-in-task-mana

Excel reste effectivement ouvert dans le gestionnaire de tâches, à priori car mon code fait appel à un élément qui ne peux pas être strictement rattaché à l'objet Graphique, et qui donc ne disparait pas avec Application.Quit.

Quelqu'un aurait-il une solution miracle pour adapter mon code ?

Merci d'avance

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

 

[Staple1600]

Bonsoir le fil, le forum

Une solution radicale (à tester)

Sub KillingMeNotSoftly()
Dim XL_is_Dead$
XL_is_Dead = "TASKKILL /F /IM excel.exe"
Shell XL_is_Dead, vbHide
End Sub

NB: avant de tuer Excel , sauvegarder les modifications des classeurs ouverts

 

[Brain Box]

@Staple1600 Merci pour ta réponse toujours aussi rapide ! A vrai dire, dans une version précédente de cette macro je concluais par une commande Shell comme celle-ci, mais à l'usage (répété) mon pauvre Excel a fini par dérailler (bugs en cascades, chargements allongés...) donc j'ai du faire une réinstallation.

Je préférerais éviter une solution aussi radicale (comme tu le soulignes très justement toi-même !).

Si je peux compléter, "l'erreur" venant des deux boucles For Each, je ne sais pas s'il est possible de les substituer ou alors de les ré-écrire un format plus détaillé (reprenant l'arborescence complète) pour résoudre ce problème...

Maxence

 

[Staple1600]

Re

Et avec celle-ci tu es plus rassuré?

Sub FermetureSansLeclair()
Dim oServ As Object, oProc As Object, cProc
Set oServ = GetObject("winmgmts:")
Set cProc = oServ.ExecQuery("Select * from Win32_Process")
For Each oProc In cProc
If oProc.Name = "EXCEL.EXE" Then
MsgBox "Fermer Excel?"
errReturnCode = oProc.Terminate()
End If
Next
End Sub

Et sans message

Sub FermetureSansLeclairEtSansPrevenir()
Dim oServ As Object, oProc As Object, cProc
Set oServ = GetObject("winmgmts:")
Set cProc = oServ.ExecQuery("Select * from Win32_Process")
For Each oProc In cProc
If oProc.Name = "EXCEL.EXE" Then
errReturnCode = oProc.Terminate()
End If
Next
End Sub

 

[Brain Box]

@Staple1600 Merci pour ta proposition ! Si je comprends bien, par rapport à la fonction Shell, .Terminate laisse le temps au programme de se fermer sans brutalité ?

Je teste bientôt et te tiens au courant !

Maxence

 

[Brain Box]

Bonsoir à tous !

Je reviens avec un peu de retard, comme à mon habitude ! J'ai fini par trouver du temps pour travailler sur ce dossier, et j'ai appliqué la recette proposée sur un des liens de mon 1er post (https://stackoverflow.com/questions...ode-still-running-in-the-process-in-task-mana), et... ça a l'air de fonctionner !

L’exécution de la procédure dans son ensemble est ralentie, mais je n'ai plus de processus fantômes - ou alors de façon très temporaire.
Pour ceux qui ne lisent pas l'anglais, l'article en question recommande une qualification très précise de toutes les références au sein de mon objet Chart PPT. J'ai également changé la boucle For Each en For... To..., mais je ne sais pas dans quelle mesure cela a pu jouer.

Pour les curieux, je poste la sous procédure qui posait problème avec un code qui, pour l'instant, fonctionne chez moi.

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

'DEFINITION DES VARIABLES

'Variables de boucles
Dim i As Integer

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

'PARTIE DANS MICROSOFT EXCEL SI GRAPHIQUE IDENTIFIE

'Désactivation des alertes Excel pour fluidifier le déroulement
shp.Chart.ChartData.Workbook.Application.DisplayAlerts = False

'Vérifie qu'il existe au moins une feuille de calcul
If shp.Chart.ChartData.Workbook.Worksheets.Count >= 1 Then
    'Boucle dans toutes les feuilles de calcul du classeur
    For i = shp.Chart.ChartData.Workbook.Worksheets.Count To 1 Step -1
        'Identifie les feuilles à supprimer par leurs noms
        If shp.Chart.ChartData.Workbook.Worksheets(i).Name <> shp.Chart.ChartData.Workbook.ActiveSheet.Name Then
            shp.Chart.ChartData.Workbook.Worksheets(i).Delete 'Supprime la feuille si nom différent
        End If
    Next
'Cellule A1 sélectionnée
shp.Chart.ChartData.Workbook.Worksheets(1).Cells(1, 1).Select
End If

'Vérifie qu'il existe au moins une feuille graphique
If shp.Chart.ChartData.Workbook.Charts.Count >= 1 Then
    'Boucle dans toutes les feuilles de calcul du classeur
    For i = shp.Chart.ChartData.Workbook.Charts.Count To 1 Step -1
        'Identifie les feuilles à supprimer par leurs noms
        If shp.Chart.ChartData.Workbook.Charts(i).Name <> shp.Chart.ChartData.Workbook.ActiveSheet.Name Then
            shp.Chart.ChartData.Workbook.Charts(i).Delete 'Supprime la feuille si nom différent
        End If
    Next
End If
      
'REINITIALISATION DE LA POSITION DU CURSEUR PUIS FERMETURE

'Rétablissement des alertes Excel
shp.Chart.ChartData.Workbook.Application.DisplayAlerts = True
'Fermeture de la feuille de calcul
shp.Chart.ChartData.Workbook.Close
'Fermeture de l'application Excel
shp.Chart.ChartData.Workbook.Application.Quit
'Suspend la macro jusqu'à fermeture
DoEvents

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

Merci @Staple1600 pour ta proposition, qui fonctionne par ailleurs car je l'ai testée, mais j'ai réussi à faire cela plus "proprement".

Maxence