Bonjour à tous,
Étant novice sur VB, je tiens tout d'abord à vous remercier par avance de l'aide que vous apporterez sur ce sujet.
Actuellement, j'utilise le programme ci-dessous comme base de mon programme.
Toute fois il me reste juste un problème que je n'arrive pas a résoudre.
La macro peut repérer les différents tableaux dans le document Word (c'est tout à fait ce qu'il me faut) à un point prés.
J'utilise des documents Word avec des mises en forme similaires (deux tableaux) sur chaque page, mais mon nombre de pages diffère (donc le nombre de tableaux à copier aussi) selon le document Word choisi.
Et-il possible d'introduire une condition pour que la macro puisse copier 1 tableau sur 2 sur chaque page et ceci sur un nombre de pages indéfini ?
renseignement secondaire : mon tableau fait maximum 35 lignes donc compter de 35 en 35 pour la position de la première cellule de chaque tableau (voir éléments en rouge)
Comme en jaune ci-dessous :
Sub copieTableauWordVersExcel_V02()
'nécéssite d'activer la référence Microsoft Word xx.x Object Library
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim Fichier As Variant
'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
If WordDoc.Tables.Count < 2 Then 'verifie si le document possede bien le tableau
WordDoc.Close False
WordApp.Quit
MsgBox "Le document sélectionné : " & Chr(10) & Chr(10) & _
Fichier & Chr(10) & Chr(10) & "ne posséde pas le tableau spécifié", , "Message"
Exit Sub
End If
WordDoc.Tables(1).Range.Copy 'copie du tableau Word
'dans Word chaque tableau est indexé
'ici l'index est à 1 car le premier index correspond au cadre autour du titre du
'document Word
Range("A9").Select
ActiveSheet.Paste 'collage des données dans Excel
WordDoc.Tables(3).Range.Copy
Range("A44").Select
ActiveSheet.Paste
WordDoc.Tables(5).Range.Copy
Range("A79").Select
ActiveSheet.Paste
WordDoc.Close False 'ferme le document Word sans sauvegarde
WordApp.Quit 'ferme l'application Word
End Sub
Je vous remercie par avance.
Antony
Étant novice sur VB, je tiens tout d'abord à vous remercier par avance de l'aide que vous apporterez sur ce sujet.
Actuellement, j'utilise le programme ci-dessous comme base de mon programme.
Toute fois il me reste juste un problème que je n'arrive pas a résoudre.
La macro peut repérer les différents tableaux dans le document Word (c'est tout à fait ce qu'il me faut) à un point prés.
J'utilise des documents Word avec des mises en forme similaires (deux tableaux) sur chaque page, mais mon nombre de pages diffère (donc le nombre de tableaux à copier aussi) selon le document Word choisi.
Et-il possible d'introduire une condition pour que la macro puisse copier 1 tableau sur 2 sur chaque page et ceci sur un nombre de pages indéfini ?
renseignement secondaire : mon tableau fait maximum 35 lignes donc compter de 35 en 35 pour la position de la première cellule de chaque tableau (voir éléments en rouge)
Comme en jaune ci-dessous :
Sub copieTableauWordVersExcel_V02()
'nécéssite d'activer la référence Microsoft Word xx.x Object Library
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim Fichier As Variant
'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
If WordDoc.Tables.Count < 2 Then 'verifie si le document possede bien le tableau
WordDoc.Close False
WordApp.Quit
MsgBox "Le document sélectionné : " & Chr(10) & Chr(10) & _
Fichier & Chr(10) & Chr(10) & "ne posséde pas le tableau spécifié", , "Message"
Exit Sub
End If
WordDoc.Tables(1).Range.Copy 'copie du tableau Word
'dans Word chaque tableau est indexé
'ici l'index est à 1 car le premier index correspond au cadre autour du titre du
'document Word
Range("A9").Select
ActiveSheet.Paste 'collage des données dans Excel
WordDoc.Tables(3).Range.Copy
Range("A44").Select
ActiveSheet.Paste
WordDoc.Tables(5).Range.Copy
Range("A79").Select
ActiveSheet.Paste
WordDoc.Close False 'ferme le document Word sans sauvegarde
WordApp.Quit 'ferme l'application Word
End Sub
Je vous remercie par avance.
Antony
Dernière édition:
