Discussion :

[anesr]

Bonjour à toute la communauté informatique,
Le néophyte que je suis aurai besoin de votre aide pour écrire une macro permettant de récupérer des données contenues dans plusieurs tableaux d'un même fichier WORD.
Ces données doivent ensuite être listées dans un fichier xslx.
En pièce jointe vous trouverez un exemple de mon fichier word d'entrée.
Pour le moment je suis capable de récupérer des données d'un seul et unique tableau dans Word mais mon code ne fonctionne plus quand "il tombe" sur des cellules fusionnées.

Voici mon code:
-----------------------------------------------------------

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub importTableWord_VersExcel()
'
' importTableWord_VersExcel Macro
'
'Nécessite d'activer la référence:
    'Microsoft Word xx.x Object Library
 
Dim WordApp As Object
Dim WordDoc As Object
Dim Tableau As Object
Dim i As Integer, j As Integer
 
 
'Création instance Word
        Set WordApp = CreateObject("Word.Application")
 
'Masque Word pendant l'opération
        WordApp.Visible = True
 
'Ouvre le document Word
        Set WordDoc = WordApp.documents.Open("C:\Users\Public\test.docx")
 
'Représente le premier tableau dans le document
        Set Tableau = WordDoc.Tables(1)
 
'Boucle sur les colonnes de chaque tableau
        For i = 1 To Tableau.Columns.Count
 
'Boucle sur les cellules de chaque colonne
            For j = 1 To Tableau.Columns(i).Cells.Count
 
'Importe les données du tableau dans la feuille active
            ActiveSheet.Cells(j, i) = Tableau.Columns(i).Cells(j)
                Next j
            Next i
 
'Ferme le document Word
        WordDoc.Close False
'Ferme l'instance Word
        WordApp.Quit
 
'
    Application.Goto Reference:="importTableWord_VersExcel"
 
End Sub

--------------------------------------------------------------
Pourriez vous m'aidez a avancer dans mon travail...
Merci d'avance à toutes et à tous.

REMICH Anestest.docx

[Ben_L]

Bonjour,

La gestion des tableaux Word fait qu'il n'est pas possible de déterminer simplement si une cellule est fusionnée.
En somme, ce que vous demandez n'est pas réalisable aisément.

Ce qu'il semble possible de faire, c'est de passer dans toutes les cellules du tableau via une boucle du type :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Dim tabl As Table, Cel As Cell
Set tabl = ThisDocument.Tables(1)
For Each Cel In tabl.Range.Cells
    <faire_quelque_chose>
Next Cel

Reste à savoir quoi faire...

A mon sens, il est tout simplement impossible d'écrire un code qui fonctionne dans le cas général, puisqu'un tableau peut avoir un nombre de colonnes différent sur chaque ligne.
Mais si on suppose que les colonnes du tableau ne sont pas décalées les unes par rapport aux autres, il devient possible de faire le boulot en se basant sur les hauteurs et largeurs de chaque cellule.

Ça va être long et fastidieux

[Invité]

Bonjour,

A tester :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
 
Option Explicit
 
Public LigneEnCours As Long, ColonneEnCours As Long
 
Sub ImporterDesTableWordVersExcel()
 
'Dim WordApp As Object
'Dim WordDoc As Object
'Dim Tableau As Object
 
'Nb : Pendant la phase de test, il vaut mieux travailler avec la référence Word cochée
 
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim Tableau As Word.Table
 
Dim I As Integer, J As Integer
 
Dim ShCible As Worksheet
Dim CelluleCible As Range
Dim CheminComplet As String
 
        CheminComplet = "C:\Users\...\test.docx" ' A adapter
 
        Set ShCible = ActiveSheet
        With ShCible
             ' .UsedRange.Clear ' Attention, on efface tout
             LigneEnCours = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
             ColonneEnCours = 1
             Set CelluleCible = .Range("A" & LigneEnCours)
        End With
 
 
        Set WordApp = CreateObject("Word.Application")
        With WordApp
             .Visible = True
             Set WordDoc = .Documents.Open(CheminComplet)
             With WordDoc
                  For I = 1 To .Tables.Count
                      Set Tableau = .Tables(I)
                      RecupererLeContenuDesCellulesWord CelluleCible, Tableau
                      Set Tableau = Nothing
                  Next I
                  .Close False
             End With
             Set WordDoc = Nothing
             .Quit
        End With
        Set WordApp = Nothing
 
        With ShCible
            With .UsedRange
                .EntireColumn.ColumnWidth = 110
                .Replace What:="", Replacement:="", LookAt:=xlPart, _
                         SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
                .Columns.AutoFit
                .Rows.AutoFit
            End With
        End With
 
        Set ShCible = Nothing
 
        MsgBox "Import terminé !", vbInformation
 
 
 
End Sub
 
 
Sub RecupererLeContenuDesCellulesWord(ByVal CelluleEnCours As Range, ByVal TableEnCours As Word.Table)
 
Dim NombreDeColonnesWord As Long, NombreDeLignesWord As Long, ColonneWord As Long, LigneWord As Long
Dim J As Integer
Dim MonRangeWord As Word.Range
Dim MonTexte As String
 
 
    With TableEnCours
         NombreDeLignesWord = .Rows.Count
         For LigneWord = 1 To NombreDeLignesWord
                NombreDeColonnesWord = .Rows(LigneWord).Cells.Count
                For ColonneWord = 1 To NombreDeColonnesWord
                    Set MonRangeWord = .Cell(LigneWord, ColonneWord).Range
                    With MonRangeWord
                         MonTexte = ""
                         For J = 1 To .Paragraphs.Count
                            MonTexte = MonTexte & .Paragraphs(J).Range.Text & Chr(10)
                         Next J
                    End With
                    CelluleEnCours.Offset(LigneEnCours, ColonneEnCours + ColonneWord) = MonTexte
                    'Debug.Print NombreDeLignesWord & ", " & NombreDeColonnesWord & " : " & MonTexte
                    Set MonRangeWord = Nothing
 
                Next ColonneWord
                LigneEnCours = LigneEnCours + 1
 
         Next LigneWord
   End With
 
End Sub

Nb : Il faut mettre votre code entre balises Code -> # . Il n'est pas trop tard pour le faire.

[anesr]

Merci pour vos retours Ben et Eric.
@ Eric:

Je pense que ton code répond au mieux à mon besoin cependant quand j’exécute la macro j'ai le message d'erreur suivant :/

[Invité]

Il faut cocher la référence Microsoft Word dans l'éditeur VBA.

Avant de travailler directement avec des variables Object pendant la phase de mise au point de votre macro, il vaut mieux pour vous de travailler avec les objets Word.

[Ben_L]

Bonjour Eric,

La méthode que vous proposez est susceptible de conduire à des erreurs lorsque le tableau Word contient des cellules fusionnées.
Ainsi, lorsque des fusions verticales de cellules sont présentes, la ligne suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

NombreDeColonnesWord = .Rows(LigneWord).Cells.Count

conduit à une erreur.

De plus, dans Word, une cellule identifiée par un numéro de ligne et un numéro de colonne est susceptible de ne pas exister.
Exemple :

Le 2ème tableau indique les numéros de ligne et de colonne de chaque cellule, tel que donnés par Word lorsqu'on utilise les propriétés RowIndex et ColumnIndex d'une cellule.

On voit ainsi que la cellule (2, 1) n'existe pas... d'où une erreur lorsqu'on exécute le code.

Il est possible de contourner le problème à l'aide d'une boucle For ... Each, comme indiqué dans mon premier post.
On peut ensuite écrire dans Excel en décalant les cellules Excel sur la base de RowIndex et ColumnIndex.
Cependant, un problème va subsister... Ci-dessous le tableau que j'obtiendrais dans Excel par cette méthode :

On voit que l'emplacement obtenu pour les différentes valeurs n'est pas vraiment celui attendu...

Cordialement

[Invité]

Bonjour Ben_L,

C'est possible que le code fourni comporte des erreurs. Mais dans ce cas précis et de façon pragmatique, il fonctionne pour le cas étudié et je n'ai pas été plus loin. Comme toujours, il faut "recetter" un code dans pas mal de configurations avant de le mettre à disposition. Cette tâche relève du demandeur. A lui d'être précis dans sa description sinon tu ne t'en sors pas.

Cordialement.

Pièce jointe 301133

[Invité]

Bonjour anesr,

Je vous suggère de lire au moins une fois les règles du forum club.developpez.com-regles notamment le chapitre 4.

Bonne lecture.