Copier un tableau de word à Excel

Medestrac -  
 Medestrac -

Bonjour,

J'ai une liste de documents word ayant la même structure. Leur nom va de C001 à C100, et ils contiennent un paragraphe intitulé "Articles de conditionnement", qui contient un tableau de 4 colonnes et x lignes (une dizaine, ça varie).

Le paragraphe suivant s'intitule "Consignes de conditionnement".

Je souhaite depuis un fichier Excel ouvrir l'un des documents, pour en extraire le tableau.

J'arrive à extraire la liste des mots de la manière suivante:

Sub Extraction()

FC = "C51"

Chemin = "C:\F.Conditionnement\"
fichier = Dir(Chemin)

Do While fichier <> ""
    If Left(fichier, 4) = FC Then exit loop
    fichier = Dir()
Loop

Set wordapp = CreateObject("word.Application")
lien = Chemin & fichier
Set WordDoc = wordapp.documents.Open(lien, ReadOnly:=True)
wordapp.Visible = True

Set collWord = WordDoc.Content.Words
For x = 1 To collWord.Count - 1
    If InStr(1, collWord(x), "Article") > 0 Then
        For y = x + 1 To collWord.Count
            If InStr(1, collWord(y), "Consignes") > 0 Then
                    For i = x To y
                        Cells(i + 1 - x, 1).Value = collWord(i)
                    Next
                Exit For
            End If
        Next
    Exit For
    End If
Next
End Sub

Ce qui ne correspond pas vraiment mon besoin.

Je voudrais respecter les colonnes et les lignes. Pouvez-vous m'aiguiller?

A voir également:

2 réponses

Réponse 1 / 2
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 

Bonjour,

voir ceci

avec un exemple à télécharger
0
Réponse 2 / 2
Medestrac
 

Merci, ça m'a bien aiguillé. Finalement je parcours les tableaux de mon document pour trouver celui qui contient "Article" en cellule(1,1), et j'en extrait les lignes suivantes:

nbTbl = WDoc.Tables.Count

For i = 1 To nbTbl
  Var = WDoc.Tables(i).Cell(1, 1).Range.Text
  result = InStr(1, Var, "Article", vbTextCompare) 'Prends en compte Articles, article, articles...
    
        If result > 0 Then
        
            Ln = WDoc.Tables(i).Rows.Count
            Set LstArticle = WDoc.Tables(i).Rows(2).Range
            LstArticle.End = WDoc.Tables(i).Rows(Ln).Range.End
            LstArticle.Copy            
            Range("A11").PasteSpecial (xlPasteValues)

            exit for

         endif
next
0