Import de Tableaux word dans Excel sous conditions

[irinaS]

Bonjour à tous !

Je me présente, je m'appelle Irina et je suis nouvelle sur ce forum.
Celui-ci est très complet et j'ai pu en parti résoudre mon problème mais pas complètement.

Je souhaiterai pouvoir importer plusieurs tableaux d'un fichier word dans mon fichier Excel et que ceux-ci se collent les uns sous les autres (avec une cellule d'espacement entre chaque)

J'ai trouvé sur ce forum un code VBA qui marche très bien sauf qu'il ne m'importe qu'un seul tableau à la fois suivant l'index indiqué dans le code :

Sub transfer()

Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim Fichier As String

Fichier = Application.GetOpenFilename("Text Files (*.doc*), *.doc*")
Set WordApp = CreateObject("Word.Application") 'creation session Word
WordApp.Visible = False 'pour que word reste masqué pendant l'opération
Set WordDoc = WordApp.Documents.Open(Fichier) 'ouverture du fichier Word

WordDoc.Tables(2).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").Select
ActiveSheet.Paste 'collage des données dans Excel

WordDoc.Close False 'ferme le document Word sans sauvegarde
WordApp.Quit 'ferme l'application Word
End Sub


Mais voilà, dans mon cas je souhaiterai que la macro importe tous les tableaux dont la première case (en haut à gauche donc) commence par "Index"

Je ne suis pas très douée en VBA, je m'y mets tout juste, quelqu'un aurait-il une idée ou une piste...

Merci à Tous !!!

Irina

 

[Guest]

Re : Import de Tableaux word dans Excel sous conditions

Bonjour Irina et bienvenue sur le forum,

Je ne suis pas un fortiche pour VBA Word mais essai ceci:

[COLOR=blue]Sub[/COLOR] transfer()
    [COLOR=blue]Dim[/COLOR] WordApp [COLOR=blue]As[/COLOR] Word.Application
    [COLOR=blue]Dim[/COLOR] WordDoc [COLOR=blue]As[/COLOR] Word.Document
    [COLOR=blue]Dim[/COLOR] Table [COLOR=blue]As[/COLOR] Word.Table
    [COLOR=blue]Dim[/COLOR] Fichier [COLOR=blue]As[/COLOR] [COLOR=blue]String[/COLOR]
    Fichier = Application.GetOpenFilename([I]"Text Files (*.doc*), *.doc*"[/I])
    [COLOR=blue]Set[/COLOR] WordApp = CreateObject([I]"Word.Application"[/I])    [COLOR=green]'creation session Word[/COLOR]
    WordApp.Visible = [COLOR=blue]False[/COLOR]    [COLOR=green]'pour que word reste masqué pendant l'opération[/COLOR]
    [COLOR=blue]Set[/COLOR] WordDoc = WordApp.Documents.[COLOR=blue]Open[/COLOR](Fichier)    [COLOR=green]'ouverture du fichier Word[/COLOR]
    [COLOR=blue]For[/COLOR] [COLOR=blue]Each[/COLOR] Table [COLOR=blue]In[/COLOR] WordDoc.Tables
        [COLOR=blue]If[/COLOR] Table.Cell(1, 1).Range.Text [COLOR=blue]Like[/COLOR] [I]"Index*"[/I] [COLOR=blue]Then[/COLOR]
            Table.Copy
            Range([I]"A"[/I] & Application.Rows.Count).[COLOR=blue]End[/COLOR](xlUp)(3).[COLOR=blue]Select[/COLOR]
            ActiveSheet.Paste    [COLOR=green]'collage des données dans Excel[/COLOR]
        [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
    [COLOR=blue]Next[/COLOR]
    WordDoc.[COLOR=blue]Close[/COLOR] [COLOR=blue]False[/COLOR]    [COLOR=green]'ferme le document Word sans sauvegarde[/COLOR]
    WordApp.Quit    [COLOR=green]'ferme l'application Word[/COLOR]
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR]

A bientôt

 

[PMO2]

Re : Import de Tableaux word dans Excel sous conditions

Bonjour,

Essayez le code suivant

Sub transfer()
Dim WordDoc As Word.Document
Dim Tableau  As Word.Table
Dim Fichier As Variant
Dim Lig&
Fichier = Application.GetOpenFilename("Text Files (*.doc*), *.doc*")
If Fichier = False Then Exit Sub
Set WordDoc = GetObject(Fichier)
Lig& = 1
For Each Tableau In WordDoc.Tables
  If UCase(Left(Tableau.Cell(1, 1), 5)) = "INDEX" Then
    Tableau.Range.Copy
    Range("A" & Lig& & "").Select
    ActiveSheet.Paste
    Lig& = Lig& + Tableau.Range.Rows.Count + 1
  End If
Next Tableau
Application.CutCopyMode = False
WordDoc.Close
Set WordDoc = Nothing
[a1].Select
End Sub

Cordialement.

PMO
Patrick Morange

 

[irinaS]

Re : Import de Tableaux word dans Excel sous conditions

Re bonjour,

Merci de vous être penché sur mon problème, mais aucune des solutions proposées ne fonctionne.

Hasco, la macro semble se lancer mais la feuille après fermeture de macro reste totalement vide avec A1 sélectionné...

PMO2, là aussi votre feuille "test" reste vide chez moi... Même avec vos fichiers joints...

Ai-je oublié quelque chose ?

Merci encore à vous.

Irina

 

[ChTi160]

Re : Import de Tableaux word dans Excel sous conditions

Salut Irina
Bonjour le Fil
Bonjour le forum
voila ce que j'ai modifié et qui chez moi fonctionne
il peut s"agir d'un problème de référence au classeur cible

Sub transfer()
Dim WordDoc As Word.Document
Dim Tableau As Word.Table
Dim Fichier As Variant
Dim Lig&
Dim Wkb As Workbook
Application.ScreenUpdating = False
Set Wkb = ThisWorkbook
Fichier = Application.GetOpenFilename("Text Files (*.doc*), *.doc*")
If Fichier = False Then Exit Sub
Set WordDoc = GetObject(Fichier)
Lig& = 1
For Each Tableau In WordDoc.Tables
If UCase(Left(Tableau.Cell(1, 1), 5)) = "INDEX" Then
Tableau.Range.Copy
Wkb.Worksheets("test").Range("A" & Lig& & "").Select
ActiveSheet.Paste
Lig& = Lig& + Tableau.Range.Rows.Count + 1
End If
Next Tableau
Application.CutCopyMode = False
WordDoc.Close
Set WordDoc = Nothing
[a1].Select
Application.ScreenUpdating = True
End Sub

mais chez moi le fichier de PMO2 fonctionne sans modif

ainsi que celle de Hasco
après avoir ajouté

If Table.Cell(1, 1).Range.Text Like "Index*" Then
Table.Range.Copy

Bonne journée

 

[Guest]

Re : Import de Tableaux word dans Excel sous conditions

Bonjour,

Hi ChTi, content de te croiser, il y avait longtemps

A+

Irina, en espérant que la méthode de Cht'i te convienne.

A+

 

[irinaS]

Re : Import de Tableaux word dans Excel sous conditions

POM2, Hasco et ChTi160,

Merci pour ces modifications ChTi, cela n'a que partiellement fonctionné chez moi mais après m'être penchée sur le sujet, et après quelques modifications dans le code cela semble aboutir à ce que je voulais.
Sauf pour la mise en page avec des hauteur de cellule bizarrement élevées.

D'ailleurs, oserais-je abuser de votre temps et de votre savoir pour vous demander 2 choses :

1.Comment déterminer avant import des tableaux combien il y en a dans le fichier word (tous tableaux compris, même ceux qu'on importe pas après) ?

2. Y a-t-il une macro permettant de redimensionner automatiquement la hauteur des cellules après import ?


Merci à vous en tous cas, vous m'évitez de recopier une centaine de tableaux à la main

Irina.

 

[PMO2]

Re : Import de Tableaux word dans Excel sous conditions

Bonjour,

Pour pouvoir poursuivre, pourriez-vous joindre un de vos documents .doc (édulcoré des données confidentielles) pour que nous puissions nous rendre compte.

Cordialement.

PMO
Patrick Morange

 

[irinaS]

Re : Import de Tableaux word dans Excel sous conditions

Re le forum, Hasco, ChTi, PMO2,

Je voudrais bien mais le problème est que mon fichier Word fait plus de 200 pages avec plus d'une centaine de tableaux... ça serait très long à modifier pour cacher les données confidentielles.

Pour ce qui est de la mise en page de la hauteur des lignes, je peux me débrouiller, mais avoir un compte du nombre de tableaux du document Word avant l'import me servirait beaucoup.

Merci encore,

Bien à vous

Irina S.

 

[PMO2]

Re : Import de Tableaux word dans Excel sous conditions

Bonjour,

avoir un compte du nombre de tableaux du document Word avant l'import

Essayez le code suivant

Sub NombreTables()
Dim WordDoc As Word.Document
Dim Tableau  As Word.Table
Dim Fichier As Variant
Dim Lig&
Fichier = Application.GetOpenFilename("Text Files (*.doc*), *.doc*")
If Fichier = False Then Exit Sub
Set WordDoc = GetObject(Fichier)

MsgBox WordDoc.Tables.Count

WordDoc.Close
Set WordDoc = Nothing
End Sub

Cordialement.

PMO
Patrick Morange