none
De Word à Excel RRS feed

  • Question

  • Bonjour, je recherche le moyen d'extraire automatiquement des tableaux contenu dans un document word de 200 pages (120 tableaux + textes) afin de pouvoir les récupérer dans des feuilles séparées.
    Merci pour votre aide
    lundi 31 mars 2014 08:49

Réponses

  • Bonjour,

    Je vous propose la solution suivante, elle consiste en une macro et une fonction à insérer dans un même module Excel (ne pas oublier d'ajouter la référence à Microsoft Word xx.x Object Library).

    Voici la macro :

    Sub copieTableauWordVersExcel()
    
        ' Macro adaptée par Mehdi HAMMADI le 31/03/2014
        ' Objectif : copier chaque tableau d'un document word vers une feuille Excel
        ' Nécéssite d'activer la référence Microsoft Word xx.x Object Library
        ' Fait appel à une fonction personnalisée nommée TestOnglet()
        ' Source du code : http://www.developpez.net/forums/d662968/logiciels/microsoft-office/excel/macros-vba-excel/transfert-d-tableau-word-vers-excel-vba/
            
        Dim WordApp As Word.Application
        Dim WordDoc As Word.Document
        Dim Fichier As String
        Dim nbTableaux As Integer
        Dim indice As Integer
        Dim nomFeuil As String
        
        On Error Resume Next
         
        'Le document Word est supposé fermé avant le lancement de la macro
        Fichier = "C:\Users\mehdi.hammadi\Desktop\Test Export Tableaux Word Vers Excel\Data.docx" 'adapter le chemin
        Set WordApp = CreateObject("Word.Application") 'creation session Word
        WordApp.Visible = True 'pour que word reste masqué pendant l'opération
        Set WordDoc = WordApp.Documents.Open(Fichier) 'ouverture du fichier Word
        
        nbTableaux = WordDoc.Tables.Count
        
        For indice = 1 To nbTableaux
            WordDoc.Tables(indice).Range.Copy 'copie du tableau Word
            nomFeuil = "Feuil" & Trim(Str(indice))
            
            'vérifier si la feuille existe, si non la créer
            If TestOnglet(nomFeuil) = False Then
                Sheets.Add After:=Sheets(Sheets.Count)
            End If
            ActiveSheet.Name = nomFeuil ' sélectionner la feuille
            Range("A1").Select ' selectionner la cellule A1
            ActiveSheet.Paste 'collage des données dans Excel
        Next
             
        WordDoc.Close False 'ferme le document Word sans sauvegarde
        WordApp.Quit 'ferme l'application Word
    End Sub

    et voici la fonction :

    Function TestOnglet(zz As String) As Boolean
        
        ' Test l'existance d'une feuille
        ' Source : http://vbaforexcel.wordpress.com/tag/verifier-existence-feuille/
        
        On Error Resume Next
        TestOnglet = Sheets(zz).Name <> ""
        On Error GoTo 0
    
    End Function

    Bonne continuation.

    Mehdi

     

    En espérant avoir pu rendre service (MehdiH)
    Retrouvez moi sur Office Users

    • Marqué comme réponse Aurel Bera mercredi 9 avril 2014 09:58
    lundi 31 mars 2014 10:17

Toutes les réponses

  • Bonjour,

    Je vous propose la solution suivante, elle consiste en une macro et une fonction à insérer dans un même module Excel (ne pas oublier d'ajouter la référence à Microsoft Word xx.x Object Library).

    Voici la macro :

    Sub copieTableauWordVersExcel()
    
        ' Macro adaptée par Mehdi HAMMADI le 31/03/2014
        ' Objectif : copier chaque tableau d'un document word vers une feuille Excel
        ' Nécéssite d'activer la référence Microsoft Word xx.x Object Library
        ' Fait appel à une fonction personnalisée nommée TestOnglet()
        ' Source du code : http://www.developpez.net/forums/d662968/logiciels/microsoft-office/excel/macros-vba-excel/transfert-d-tableau-word-vers-excel-vba/
            
        Dim WordApp As Word.Application
        Dim WordDoc As Word.Document
        Dim Fichier As String
        Dim nbTableaux As Integer
        Dim indice As Integer
        Dim nomFeuil As String
        
        On Error Resume Next
         
        'Le document Word est supposé fermé avant le lancement de la macro
        Fichier = "C:\Users\mehdi.hammadi\Desktop\Test Export Tableaux Word Vers Excel\Data.docx" 'adapter le chemin
        Set WordApp = CreateObject("Word.Application") 'creation session Word
        WordApp.Visible = True 'pour que word reste masqué pendant l'opération
        Set WordDoc = WordApp.Documents.Open(Fichier) 'ouverture du fichier Word
        
        nbTableaux = WordDoc.Tables.Count
        
        For indice = 1 To nbTableaux
            WordDoc.Tables(indice).Range.Copy 'copie du tableau Word
            nomFeuil = "Feuil" & Trim(Str(indice))
            
            'vérifier si la feuille existe, si non la créer
            If TestOnglet(nomFeuil) = False Then
                Sheets.Add After:=Sheets(Sheets.Count)
            End If
            ActiveSheet.Name = nomFeuil ' sélectionner la feuille
            Range("A1").Select ' selectionner la cellule A1
            ActiveSheet.Paste 'collage des données dans Excel
        Next
             
        WordDoc.Close False 'ferme le document Word sans sauvegarde
        WordApp.Quit 'ferme l'application Word
    End Sub

    et voici la fonction :

    Function TestOnglet(zz As String) As Boolean
        
        ' Test l'existance d'une feuille
        ' Source : http://vbaforexcel.wordpress.com/tag/verifier-existence-feuille/
        
        On Error Resume Next
        TestOnglet = Sheets(zz).Name <> ""
        On Error GoTo 0
    
    End Function

    Bonne continuation.

    Mehdi

     

    En espérant avoir pu rendre service (MehdiH)
    Retrouvez moi sur Office Users

    • Marqué comme réponse Aurel Bera mercredi 9 avril 2014 09:58
    lundi 31 mars 2014 10:17
  • Bonjour, merci pour les informations, malheureusement je suis infographiste et non informaticien……

    je ne sais pas ou placer la fonction.

    lundi 31 mars 2014 12:18
  • Bonjour,

    Je viens de partager un dossier zipper avec un exemple de la solution http://1drv.ms/1femjud

    Pour tester la solution procéder comme suit :

    1. Décompressez le dossier
    2. Ouvrez le fichier Excel
    3. Activez le contenu
    4. Appuyez sur ALT+F8
    5. Exécuter la macro

    Cordialement,

    Mehdi


    En espérant avoir pu rendre service (MehdiH)
    Retrouvez moi sur Office Users

    lundi 31 mars 2014 13:33
  • Merci, je vais tester

    Cordialement

    lundi 31 mars 2014 14:35
  • Bonjour

    infographiste, avez-vous des nouvelles pour nous?

    Merci!

    Bien cordialement,


    Aurel BERA, MSFT
    MSDN Community Support. LE CONTENU EST FOURNI "TEL QUEL" SANS GARANTIE D'AUCUNE SORTE, EXPLICITE OU IMPLICITE.
    S'il vous plaît n'oubliez pas de "Marquer comme réponse" les réponses qui ont résolu votre problème. C'est une voie commune pour reconnaître ceux qui vous ont aidé, et rend plus facile pour les autres visiteurs de trouver plus tard la résolution.

    jeudi 3 avril 2014 11:35
  • Bonjour, je rencontre des difficultés pour mettre le chemin de mon fichier car je travaille sur un IMAC.

    Merci pour une aide

    mercredi 9 avril 2014 13:54
  • Désolé mais je n'ai pas la possibilité de vous aider car je suis sur PC et non MAC.

    Bonne continuation,

    Mehdi


    En espérant avoir pu rendre service (MehdiH)
    Retrouvez moi sur Office Users

    mercredi 9 avril 2014 14:57
  • OK

    Merci

    mercredi 9 avril 2014 15:07