Bonjour à tous,

je sollicite votre aide sur un sujet qui me pose quelques difficultés et après plusieurs essais et recherches infructueuses je m’avoue vaincu.
De quoi s'agit-il :
a) je souhaite parcourir un tableau contenu dans un fichier word,
b) copier le contenu de chaque cellule,
c) et coller les éléments dans un fichier excel.

Données d'entrées : tableau Word avec deux colonnes maxi et deux ou quatre lignes maxi ( J'ai attaché au message un word avec un extrait du type de tableau concerné voir en bas )
sortie attendu : tableau d'une ligne Excel.

problèmes rencontrés :

1) Une cellule du tableau Word contient une donnée avec un style particulier n'est pas copié. Chaque tableau contient un ID du type [CDC......] dans la première cellule du tableau. Toutes les autres cellules sont bien copié mais celle-ci ne l'est pas et je ne sais pour quelle raison.
2) Pas de solution trouvée pour que les données soient copiés sur une seul ligne. Mon souhait est que toutes les données copiés soient placés dans des cellules contiguës et sur une seule ligne. j'ai essayé avec l'offset mais çà marche aléatoirement.


je vous remercie pour votre aide.


Code proposé :

Sub CopyTab()

For Itab = 1 To .Tables.Count

ReDim Tableau(1 To .Tables(Itab).Rows.Count, 1 To .Tables(Itab).Columns.Count)

For ligne = 1 To .Tables(Itab).Rows.Count

For colonne = 1 To .Tables(Itab).Columns.Count

Chaine = ""

If Exist_cell(Itab, ligne, colonne) Then

Chaine = .Tables(Itab).Cell(Row:=ligne, Column:=colonne)

Chaine = Replace(Replace(Chaine, Chr(7), ""), Chr(13), Chr(10))
Tableau(ligne, colonne) = Chaine

End If


Next colonne


Next ligne
End sub

Function Exist_cell(Num As Integer, j As Integer, k As Integer) As Boolean
Dim Chaine As String

Exist_cell = True
On Error GoTo errhdlr
Chaine = WordDoc.Tables(Num).Cell(j, k).Range.Text
Exit Function

errhdlr:
Exist_cell = False
End Functiontesttableau.docx