Insérer des données excel dans un tableau word

Version imprimable

Bonjour amis développeurs et à tout le forum,

Question à 100 balles sur le fonctionnement des tableaux dans word. Je voudrais copier des cellules d'un classeur excel dans un tableau word.
Le but est de pouvoir garder le résultats des cellules du classeur excel les unes en dessous des autres dans ce tableau.
Dans une macro vba, j'utilise ce code pour faire le lien entre word et excel :
Code:

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 Dim DocWord As Word.Document Dim Chemin, lettre_col_offre, lettre_col_qté, lettre_col_art, lettre_col_fin As String Dim qté, ligne, i_ligne, col_offre, col_qté, i_fin As Integer 'Récupération indice ligne du tableau + colonne quantité + colonne offre i_ligne = Application.Match("Elément", Worksheets(nom).Columns(1), 0) i_fin = Application.Match("fin", Worksheets(nom).Columns(1), 0) col_qté = Application.Match("Qté", Worksheets(nom).Rows(i_ligne & ":" & i_ligne), 0) col_offre = Application.Match("Désignation paragraphe offre", Worksheets(nom).Rows(i_ligne & ":" & i_ligne), 0) 'Récupération des indices en "lettre" des colonnes qté et offre (ex indice "lettre" : "A") lettre_col_art = Split(Worksheets(nom).Columns(col_offre + 5).Address(ColumnAbsolute:=False), ":")(1) lettre_col_offre = Split(Worksheets(nom).Columns(col_offre + 6).Address(ColumnAbsolute:=False), ":")(1) lettre_col_qté = Split(Worksheets(nom).Columns(col_offre + 7).Address(ColumnAbsolute:=False), ":")(1) Chemin = Environ("USERPROFILE") & "\Mes documents\Offre2017" 'Ouvre le document Word Set DocWord = GetObject(Chemin & "\test.docx") DocWord.Application.Visible = True 'Copie les données dans excel Worksheets(nom).Range(lettre_col_offre & i_ligne & ":" & lettre_col_qté & i_fin).Copy 'Colle la désignation offre dans Word DocWord.Range(Start:=0, End:=1).PasteSpecial Application.CutCopyMode = False
Je rencontre un problème à partir de cette ligne de code :

Code:

DocWord.Range(Start:=0, End:=1).PasteSpecial

Lorsque la macro est appelée plusieurs fois, les données ne s'insèrent pas à la suite mais dans la première case du tableau.
Quel serait le code pour pouvoir obtenir une insertion des données excel à la suite ?

Je me débrouille avec VBA Excel mais je suis un peu novice avec VBA sur Word.
J'ai cherché du code sur le forum mais je ne pense pas l'utiliser correctement. Pour info, la macro doit se déclencher dans excel.

Merci d'avance pour vos retours,
Cordialement,
BDA53

26/07/2018, 10h10
Menhir

Perso, j'ai beaucoup galéré sur les échanges Excel -> Word.

Maintenant, je m'en tiens à 2 méthodes.

Soit il s'agit de données éparses disséminées dans un texte ou semées ici et là : dans ce cas, je passe par des bookmark.

Soit il s'agit de données de masse façon tableau (comme ça semble être ton cas) et, dans ce cas, je crée un fichier type (pour ne pas dire "modèle" qui a une signification particulière) avec un embryon de tableau vide d'une seule ligne (avec les format qui vont bien pour ce que je souhaite y déposer).
Avec une brutale boucle For To, je copie cette ligne vierge de tableau Word autant de fois qu'il y a de ligne de données dans Excel en y transférant à chaque fois les données avec un simple = (pas de copy) du style :

Code:

DocuWord.Tables(1).Rows(WLigne).Cells(1).Range.Text = WSSource.Cells(XLigne, 1).Text

C'est comme une 2CV : c'est pas beau, c'est pas rapide, mais fabuleusement fiable et robuste.

Bonjour menhir et merci pour ton retour,

Dans la ligne de code que tu as mis en commentaire, WSSource est un objet avec le chemin d'accès du fichier excel ?
J'obtiens une erreur dans ce bloc de code :
Code:

1 2 3 4 5 6 'Pour info i_ligne = 13, i_offre = 0 et col_offre = 4 For ligne = i_ligne + 1 To Worksheets(nom).Range("AK13").End(xlDown).Row i_offre = i_offre + 1 DocWord.Tables(1).Rows(i_offre).Cells(1).Range.Text = ThisWorkbook.Worksheets(nom).Cells(ligne, col_offre + 6).Text DocWord.Tables(1).Rows(i_offre).Cells(2).Range.Text = ThisWorkbook.Worksheets(nom).Cells(ligne, col_offre + 7).Text Next ligne
Voici l'intitulé de l'erreur : "Erreur d'éxécution 5941 : Le membre de la collection requis n'existe pas"

26/07/2018, 12h17
Menhir

Citation:

Envoyé par BDA53

Voici l'intitulé de l'erreur : "Erreur d'éxécution 5941 : Le membre de la collection requis n'existe pas"

Ce n'est pas une erreur de syntaxe mais vraisemblablement une erreur d'indice.
Il faut que tu vérifies que chaque collection que tu utilises dans cette ligne possède un nombre d'élément correspondant à la valeur de l'indice.
26/07/2018, 13h25
BDA53

Ok je viens de comprendre le problème. En fait avec la ligne de code que tu m'as donnée il faut que le tableau dans word existe déjà.
Est-ce qu'il y a un code qui permet d'initialiser le tableau avant ? ou un code permettant d'ajouter une ligne dans un tableau sur word ?
26/07/2018, 14h00
Menhir
Citation:

Envoyé par BDA53

En fait avec la ligne de code que tu m'as donnée il faut que le tableau dans word existe déjà.

C'est bien ce que j'avais dit, relis mon message avec plus d'attention.

Citation:

Est-ce qu'il y a un code qui permet d'initialiser le tableau avant ?

Comme je l'ai dit, perso je me fabrique "à la main" un fichier type réutilisable.
C'est beaucoup plus rapide et souple pour régler les formats.

Citation:

un code permettant d'ajouter une ligne dans un tableau sur word ?

De la même façon qu'à la main :
Code:

1 2 DocuWord.Tables(1).Rows(WLigne).Range.Copy DocuWord.Tables(1).Rows(WLigne).Range.Paste

Merci beaucoup menhir,

En utilisant copy + paste pour ajouter des lignes de tableaux dans word cela fonctionne.
Du coup voici le code qui fonctionne si quelqu'un se retrouve dans la même situation que moi :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
'Copier l'entête du tableau excel 
    Worksheets(nom).Range(lettre_col_offre & i_ligne & ":" & lettre_col_qté & i_ligne).Copy
    'Coller l'entête dans Word
    DocWord.Range(Start:=0, End:=1).PasteSpecial
    Application.CutCopyMode = False
 
   i_ligne = 13
   i_offre = 0  
 
    For ligne = i_ligne + 1 To Worksheets(nom).Range("AK13").End(xlDown).Row
        i_offre = i_offre + 1
        DocWord.Tables(1).Rows(i_offre).Cells(1).Range.Text = ThisWorkbook.Worksheets(nom).Cells(ligne, col_offre + 6).Text
        DocWord.Tables(1).Rows(i_offre).Cells(2).Range.Text = ThisWorkbook.Worksheets(nom).Cells(ligne, col_offre + 7).Text
        DocWord.Tables(1).Rows(i_offre).Range.Copy
        DocWord.Tables(1).Rows(i_offre).Range.Paste
    Next ligne

Bonne journée,
BDA53

26/07/2018, 16h33
Menhir

Il manque un dernier détail : supprimer la dernière ligne de ton tableau Word à la fin.