Copie de tous les tableaux word dans 1 feuille xls

[plim]

Bonjour,
J'ai lu pas mal de post sur le sujet sans arriver a faire ce que je voulais. peut etre pouvez vous m'aider.

Pour l'ouverture de word depuis excel , pas de probleme.
c'est pour récuperer les donnée et les copier que ca coince... )

J'ai plusieurs tableaux ( nombre non connu ) dans word basés sur ce format la:

tableau 1

| Obj ref | description | comments |
| ref 1 | desc 1 | comment |
| ref 2 | desc 2 | comment |


Tableau X
| Obj ref | description | comments |
| ref 3 | desc 3 | comment |
| ref 4 | desc 4 | comment |


les colones sont toujours les memes (6) , le nombre de lignes peut varier

Mon objectif est de concatener dans 1 seule feuille excel toutes les lignes de tous les tableaux word ( sauf la premiere ligne car c'est l'explication des col )

resultat.
sheet1
A B C
1| Obj ref | description | comments |
2| ref 1 | desc 1 | comment |
3| ref 2 | desc 2 | comment |
4| ref 3 | desc 3 | comment |
5| ref 4 | desc 4 | comment |


C'est peut etre simple, mais vba et moi ca fait 3 ... 🙂
Merci pour votre coup de pouce.

 

[plim]

Re : Copie de tous les tableaux word dans 1 feuille xls

Merci Chris de t'interresser à la question 🙂

voila mon code , que vous reconnaitrez pour etre largement inspiré des autres discussion.



NB_ligne = 1


'affichage boite de dialogue pour choisir un document Word
Fichier = Application.GetOpenFilename("Text Files (*.doc*), *.doc*")
If Fichier = False Then Exit Sub

'le document Word est supposé fermé avant le lancement de la macro
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = False 'pour que word reste masqué pendant l'opération
Set WordDoc = WordApp.Documents.Open(Fichier) 'ouverture du fichier Word


For i = 1 To WordDoc.Tables.Count


WordDoc.Tables(i).Range.Copy 'copie du tableau Word
'dans Word chaque tableau est indexé
'ici l'index est à 2 car le premier index correspond au cadre autour du titre du
'document Word


'Range("A1").Offset(NB_ligne).Select -> avant proposition de chris
Range("A" & NB_ligne).Select -> PROPOSITION DE CRHIS
ActiveSheet.Paste 'collage des données dans Excel

NB_ligne = NB_ligne + WordDoc.Tables(i).Rows.Count


Next i

Pour les deux premier tableau, ca marche plutot bien, et puis apres ca part à la dérive.
le 3eme tableau est copié sans etre indexé.

je viens de comprendre que j'ai en fait des sous tableau !!!
un format beaucoup plus complexe a copier
plutot du style :

Obj ref | description | comments |
| ref 1 | desc 1 | comment |
comment2
comment3
| ref 2 | desc 2 | comment |




comment1,comment2 comment3 etant dans un tableau dont la longueur peut varier bien sur.


Au final , ca plante avec un msg Data on the clipboard is not the same size and Shape as the selection area Do you want to paste the selection anyway
Apres ca part en live. 🙁

Comme je n'ai pas besoin de cette colonne, la solution la plus simple serait de ne pas la copier. je contourne donc le probleme. Avez vous une solution pour remplacer WordDoc.Tables(i).Range.Copy par une commande qui ne copie que les 2 premieres colonnes.

 

[plim]

Re : Copie de tous les tableaux word dans 1 feuille xls

message posté en double, supprimé, dsl

 

[chris]

Re : Copie de tous les tableaux word dans 1 feuille xls

RE
Pas simple.
D'après ce que j'ai compris (des explications de l'autre fil), WordDoc.Tables.Count compte tous les tableaux donc les tableaux imbriqués dans les tableaux doivent mettre la pagaille.
Il faudrait tester si le tableau trouvé n'a pas le bon nombre de colonne et faire un next i pour ne pas récupérer ces sous-tableaux mais quid du tableau contenant ? A tester.

Cependant dans ce cas là j'ai tendance à repartir à la source : pourquoi ces tableaux Word plutôt que des Excel ?

Est-ce un unique modèle à transposer sous Excel ou bien cette manip sera t-elle régulière ?

Il est parfois plus efficace de traiter le problème à la source que de monter une usine à gaz d'où mes questions.

 

[plim]

Re : Copie de tous les tableaux word dans 1 feuille xls

tu as tout compris... la grouille vient de la.

je suis d'accord qu'il faudrait revoir le probleme à la source. mais voila, les problemes de l'administration sont inpénétrable ! le document source appartient à un fournisseur externe. Avec Doors j'aurais déja terminé ! je ne suis qu'un GFFO : Grouillot de Fin Fond d'Organigramme.
Maintenant si je te dit que ce document regroupe un partie des test systeme d'un gros avion vous ne me croiriez pas 😉

j'ai des documents qui arrive tous les deux jours, voir plusieurs versions dans la meme journée. d'ou la nécéssité d'automatiser au plus vite.

Comment je peux faire pour tester les tableaux ? je pourais tester si la premiere cellule contient le mot clé ObjectifID et si c'est pas le cas, passer à la suite. as tu le bout de code pour lire le contenu de la cellule ?

 

[chris]

Re : Copie de tous les tableaux word dans 1 feuille xls

Re
La grouille ne vient pas forcément des imbrications : j'ai testé sur des tableaux divers.
En fait le PB vient du fait que chaque fin de paragraphe dans une cellule de tableau Word, crée une cellule dans Excel. A contrario les autres cellules du tableau apparaissent fusionnées dans Excel.
Donc le nombre de lignes que renvoit WordDoc.Tables(i).Rows.Count est inutilisable.
Par ailleurs comme des cellules sont fusionnées, qu'il y a des cellules vides, la méthode habituelle pour trouver la dernière ligne remplie dans Excel ne marche pas bien.
J'arrive à un résultat sans chevauchement avec les lignes suivantes

Range("A" & NB_ligne).Select '-> PROPOSITION DE CRHIS
ActiveSheet.Paste 'collage des données dans Excel
Cells.MergeCells = False
NB_ligne1 = Range("A10000").End(xlUp).Row
NB_ligne2 = Range("b10000").End(xlUp).Row
NB_ligne3 = Range("c10000").End(xlUp).Row
NB_ligne = Application.Max(NB_ligne1, NB_ligne2, NB_ligne3) + 1
Next i

Selon ton cas de figure il faudra peut-être créer NB_ligne4, NB_ligne5, NB_ligne6 pour tester sur 6 colonnes et obtenir avec Application.Max la cellule pleine la plus basse des 6.

Après le contenu de tableau Excel reste à exploiter...

Bon courage

 

[plim]

Re : Copie de tous les tableaux word dans 1 feuille xls

Hello,
Thank you Chris !

Ca fonctionne bien ! le code final ressemble donc à :

For i = 1 To WordDoc.Tables.Count


WordDoc.Tables(i).Range.Copy 'copie du tableau Word
'dans Word chaque tableau est indexé
'ici l'index est à 2 car le premier index correspond au cadre autour du titre du
'document Word


'Range("A1").Offset(NB_ligne).Select
Range("A" & NB_ligne).Select
ActiveSheet.Paste 'collage des données dans Excel
Cells.MergeCells = False
NB_ligne1 = Range("A10000").End(xlUp).Row
NB_ligne2 = Range("b10000").End(xlUp).Row
NB_ligne3 = Range("c10000").End(xlUp).Row
NB_ligne4 = Range("d10000").End(xlUp).Row
NB_ligne5 = Range("e10000").End(xlUp).Row
NB_ligne6 = Range("f10000").End(xlUp).Row

NB_ligne = Application.Max(NB_ligne1, NB_ligne2, NB_ligne3, NB_ligne4, NB_ligne5, NB_ligne6) + 1

Next i

je vais maintenant m'amuser a virer la premiere ligne qui est recopier inutilement.
Encore une fois, Merci !