XL 2010 400 fichier Word à insérer sur Excel

[adel.benmahmoud79]

Bonjour,
J’ai 400 fichiers word qui contiennent des rapports personnels dans des tableaux que je veux les transformer dans un seul fichier Excel.
Est-ce que c'est possible ?
Avez-vous des propositions ?

Merci d’avance.

 

[Staple1600]

Bonjour @adel.benmahmoud79 , le fil

@adel.benmahmoud79
En guise d'exemple
Test OK sur Office 365 avec des fichiers Word simples.
Ici pour le test, 5 fichiers Word d'une seule page, contenant un tableau de 5 lignes sur 3 colonnes

Spoiler: Cliquez pour voir le code VBA

Sub Copie_TableauxWord_vers_Excel()
'Déclarations variables
Dim ws As Worksheet, str_Path$, Nom_Fic$, wordApp As Object, wordDoc As Object
Dim table As Object, row As Object, cell As Object, lig&, xCol&
 
Set ws = ThisWorkbook.Sheets(1)
str_Path = "C:\Users\STAPLE\Documents\XLD_TESTS\" '<- chemin à adapter

lig = 1
 
On Error Resume Next
Set wordApp = CreateObject("Word.Application")
'boucle sur les *.docx
Nom_Fic = Dir(str_Path & "*.docx")
Do While Nom_Fic <> ""
    Set wordDoc = wordApp.Documents.Open(str_Path & Nom_Fic)
    For Each table In wordDoc.Tables
        xCol = 1
        For Each row In table.Rows
            For Each cell In row.Cells
                ws.Cells(lig, xCol).Value = CleanText(cell.Range.text)
                xCol = xCol + 1
            Next cell
            lig = lig + 1
            xCol = 1
        Next row
    Next table
    wordDoc.Close False
    Nom_Fic = Dir
Loop
wordApp.Quit
Set wordApp = Nothing
MsgBox "Recopie terminée.", vbInformation, "Import Word"
End Sub
Function CleanText(text As String) As String
CleanText = Replace(Replace(text, Chr(13), ""), Chr(7), "")
End Function

Voici le résultat obtenu dans Excel.

PS: j'ai ajouté les couleurs manuellement pour distinguer les 5 fichiers Word.

EDITION: Version modifiée pour récupérer le nom des fichiers en colonne A, les données à partir de la colonne B

Spoiler: Cliquez pour voir le code VBA

Sub TableauxWord_vers_Excel()
'Déclarations variables
Dim ws As Worksheet, str_Path$, Nom_Fic$, wordApp As Object, wordDoc As Object
Dim table As Object, row As Object, cell As Object, lig&, xCol&
Set ws = ThisWorkbook.Sheets(1)
str_Path = "C:\Users\STAPLE\Documents\XLD_TESTS\" '<- chemin à adapter
lig = 1
On Error Resume Next
Set wordApp = CreateObject("Word.Application")
'boucle sur les *.docx
Nom_Fic = Dir(str_Path & "*.docx")
Do While Nom_Fic <> ""
    ws.Cells(lig, 1).Value = Nom_Fic 
    Set wordDoc = wordApp.Documents.Open(str_Path & Nom_Fic)
    For Each table In wordDoc.Tables
        xCol = 2
        For Each row In table.Rows
            For Each cell In row.Cells
                ws.Cells(lig, xCol).Value = CleanText(cell.Range.text)
                xCol = xCol + 1
            Next cell
            lig = lig + 1
            xCol = 2
        Next row
    Next table
    wordDoc.Close False
    Nom_Fic = Dir
Loop
wordApp.Quit
Set wordApp = Nothing
MsgBox "Recopie terminée.", vbInformation, "Import Word"
End Sub
Function CleanText(text As String) As String
    CleanText = Replace(Replace(text, Chr(13), ""), Chr(7), "")
End Function

 

[adel.benmahmoud79]

Merci beaucoup
Je vais l’essayer

 

[adel.benmahmoud79]

Merci beaucoup
Je vais l’essayer

Bonjour @adel.benmahmoud79 , le fil

@adel.benmahmoud79
En guise d'exemple
Test OK sur Office 365 avec des fichiers Word simples.
Ici pour le test, 5 fichiers Word d'une seule page, contenant un tableau de 5 lignes sur 3 colonnes

Spoiler: Cliquez pour voir le code VBA

Sub Copie_TableauxWord_vers_Excel()
'Déclarations variables
Dim ws As Worksheet, str_Path$, Nom_Fic$, wordApp As Object, wordDoc As Object
Dim table As Object, row As Object, cell As Object, lig&, xCol&
 
Set ws = ThisWorkbook.Sheets(1)
str_Path = "C:\Users\STAPLE\Documents\XLD_TESTS\" '<- chemin à adapter

lig = 1
 
On Error Resume Next
Set wordApp = CreateObject("Word.Application")
'boucle sur les *.docx
Nom_Fic = Dir(str_Path & "*.docx")
Do While Nom_Fic <> ""
    Set wordDoc = wordApp.Documents.Open(str_Path & Nom_Fic)
    For Each table In wordDoc.Tables
        xCol = 1
        For Each row In table.Rows
            For Each cell In row.Cells
                ws.Cells(lig, xCol).Value = CleanText(cell.Range.text)
                xCol = xCol + 1
            Next cell
            lig = lig + 1
            xCol = 1
        Next row
    Next table
    wordDoc.Close False
    Nom_Fic = Dir
Loop
wordApp.Quit
Set wordApp = Nothing
MsgBox "Recopie terminée.", vbInformation, "Import Word"
End Sub
Function CleanText(text As String) As String
CleanText = Replace(Replace(text, Chr(13), ""), Chr(7), "")
End Function

Voici le résultat obtenu dans Excel.
Regarde la pièce jointe 1215493
PS: j'ai ajouté les couleurs manuellement pour distinguer les 5 fichiers Word.

EDITION: Version modifiée pour récupérer le nom des fichiers en colonne A, les données à partir de la colonne B

Spoiler: Cliquez pour voir le code VBA

Sub TableauxWord_vers_Excel()
'Déclarations variables
Dim ws As Worksheet, str_Path$, Nom_Fic$, wordApp As Object, wordDoc As Object
Dim table As Object, row As Object, cell As Object, lig&, xCol&
Set ws = ThisWorkbook.Sheets(1)
str_Path = "C:\Users\STAPLE\Documents\XLD_TESTS\" '<- chemin à adapter
lig = 1
On Error Resume Next
Set wordApp = CreateObject("Word.Application")
'boucle sur les *.docx
Nom_Fic = Dir(str_Path & "*.docx")
Do While Nom_Fic <> ""
    ws.Cells(lig, 1).Value = Nom_Fic
    Set wordDoc = wordApp.Documents.Open(str_Path & Nom_Fic)
    For Each table In wordDoc.Tables
        xCol = 2
        For Each row In table.Rows
            For Each cell In row.Cells
                ws.Cells(lig, xCol).Value = CleanText(cell.Range.text)
                xCol = xCol + 1
            Next cell
            lig = lig + 1
            xCol = 2
        Next row
    Next table
    wordDoc.Close False
    Nom_Fic = Dir
Loop
wordApp.Quit
Set wordApp = Nothing
MsgBox "Recopie terminée.", vbInformation, "Import Word"
End Sub
Function CleanText(text As String) As String
    CleanText = Replace(Replace(text, Chr(13), ""), Chr(7), "")
End Function

en fait je ne connais rien sur le VBA.
pouvez-vous svp me donner suite sur ces deux termes :
'Déclarations variables
'boucle sur les *.docx

merci d'avance

 

[Staple1600]

Bonsoir

@adel.benmahmoud79
Ce qui apparait en vert dans le code VBA, c'est ce qu'on appelle les commentaires
(qui ont pour but d'expliquer ou de donner des détails)
Donc ici

'Déclarations variables

Veut dire que les lignes de code qui suivent sont dédiées à la déclaration des variables
et

'boucle sur les *.docx

Indique qu'on boucle sur tous les fichiers avec l'extension *.docx (donc des fichiers Word)