Vitesse d'exécution très lente - Amélioration possible?

Question

J'avais posté sur ce forum il y a quelques temps pour une macro me permettant d'importer les tables de matière d'un ensemble de doc Word dans des feuille Excel. Avec votre aide (merci beaucoup Scaper) nous étions arriver à quelque chose qui fait exactement ce que je veux! Le seul (gros) bémol étant le temps d'exécution . Le code mets 2mn40 à s'exécuter sur un dossier contenant 2 fichiers. Ce qui est bizarre c'est que j'ai l'impression qu'il pourrait aller beaucoup plus vite: Visuellement, en 5-6s la première table des Matières s'importe, puis ca rame pendant 1m15. Puis a nouveau, en 5-6s la seconde table des matière s'importe et encore 1m15 de moulinette.. Concrètement, 1m20 par fichier, cela ne fait pas gagner de temps par rapport à un copier coller, mais si on arrive à 10s par fichier la c'est autre chose! (on parle pour 15 fichier de passer de 20mn à 2mn30) Donc voila, ma question étant: est ce "normal"? Qu'est ce qui prend autant de temps dans le code? J'ai déjà essayer de désactiver l'actualisation de l'affichage mais ca ne fais pas gagner de temps. Je vous joint l'Excel en question (contenant la macro) ainsi que deux Word type (a mettre dans un même dossier) qui me servent de test. Merci à vous de m'avoir lu. Bonne journée Baptiste...

Cylfo · Accepted Answer

Le temps d'exécution où il ne se passe rien me semble lié au parcours des autres paragraphes (à priori 1051) que celui de la table des matières. Dans le fichier joint, je te propose une autre méthode qui consiste à lire directement la table des matières et c'est nettement plus rapide, seul bémol je ne récupère pas le nom donné à la table des matières (SOMMAIRE dans les fichiers exemples). Pour l'instant, je n'ai pas trouvé mais si c'est important, je regarderai de manière plus approfondie. Cdlt, Cylfo...

Invité · Accepted Answer

Une solution "simple" pour moi Sub RecupererTableMatieres() Dim Dossier As String, Fichier As String Dim wordApp As Object, wordDoc As Object Dim tocRange As Object Dim Tab1Lig As Variant, Tab2Lig As Variant Dim Lig As Long, nLig As Long, Ind As Integer Dossier = ThisWorkbook.Path & "\" Fichier = Dir(Dossier & "\*.doc*", vbNormal) ' Créer une instance de l'application Word Set wordApp = CreateObject("Word.Application") ' Ouvrir le document Word Set wordDoc = wordApp.Documents.Open(Dossier & Fichier) ' Récupérer la portée de la table des matières Set tocRange = wordDoc.TablesOfContents(1).Range ' Récupérer le texte de la table des matières Tab1Lig = Split(tocRange.Text, vbCr) For Lig = 0 To UBound(Tab1Lig) Tab2Lig = Split(Tab1Lig(Lig), vbTab) For Ind = 0 To UBound(Tab2Lig) Sheets(2).Cells(1 + Lig, 1 + Ind).Value = Tab2Lig(Ind) Next Ind Next Lig ' Fermer le document Word wordDoc.Close SaveChanges:=False ' Fermer l'application Word wordApp.Quit End Sub Je ne sais pas si cela répondra à votre demande, mais c'est rapide, le plus long est l'ouverture du fichier Word A+...