Besoin d'aide pr finir macro transfert tableau excel vers word

M@tt · 26 Février 2009

Bonjour à tous

J'ai trouver un code pour transférer des celulles excel vers des cases données dans un tableau word déja existant qui correspond exactement à mes besoins.

Le probleme est que mes colonnes excel peuvent contenir beaucoup de lignes donc je me voi mal faire mon code cellule par cellule!!

Si quelqu'un pouvai modifier le code pour qu il boucle jusqu'à la derniere ligne excel contenant des données ca me simplifierai la vie !

Par avance merci
M@tt

Code:

Sub TransfertWord()
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
 
Set WordApp = CreateObject("word.application")
WordApp.Visible = True [COLOR="palegreen"]'mettre False pour garder Word masqué[/COLOR]
Set WordDoc = WordApp.Documents.Open("C:\monDocument.doc") [COLOR="palegreen"]'ouvre le document Word"[/COLOR]
 
[COLOR="PaleGreen"]'Tables(1) correspond au 1eme tableu du document Word
'transfert la donnée de la cellule A1 dans la 2eme cellule de la 1ere colonne[/COLOR]
WordDoc.Tables(1).Columns(1).Cells(2).Range.Text = Range("A2")
 
[COLOR="palegreen"]'transfert la donnée de la cellule B2 dans la 2eme cellule de la 2eme colonne[/COLOR]
WordDoc.Tables(1).Columns(2).Cells(2).Range.Text = Range("B2")
 
WordDoc.Close True [COLOR="palegreen"]'ferme le document Word en enregistrant les modifications[/COLOR]
WordApp.Quit [COLOR="palegreen"]'ferme l'application Word[/COLOR]
 
End Sub

Jeremyy · 26 Février 2009

Re : Besoin d'aide pr finir macro transfert tableau excel vers word

et bien il faut que tu calcul ton nombre de ligne sous excel et tu boucle tout sa !

exemple :

Code:

range("A1").select [COLOR="deepskyblue"]'Tu te met dans la cellule ou tu commence[/COLOR]derligne = 0
derligne = Range("A65536").End(xlUp).Row    [COLOR="deepskyblue"]'derligne te donne le nombre de ligne jusque ta derniere ligne pleine[/COLOR]et tu fais une boucle de ce genre :
for i = 0 to derligne 
[COLOR="DeepSkyBlue"] 'ICI TON CODE QUE TU VEUX RéPéTER[/COLOR]
next i

M@tt · 26 Février 2009

Re : Besoin d'aide pr finir macro transfert tableau excel vers word

En fait me suis mal expliqué dans mon premier post j'aimerai savoir s'y il y a possibilité de boucler le genre de code que j'ai pour ne pas avoir a répéter le code autant de fois que j'ai de ligne ds mon tableau excel sachant que les numéros de ligne corresponde entre excel et word mais pas les numéros de colonne.

Code:

Sub TransfertWord()
Dim WordApp As Word.Application
Dim WordDoc As Word.Document

    Set WordApp = CreateObject("word.application")
    WordApp.Visible = True    'mettre False pour garder Word masqué
    Set WordDoc = WordApp.Documents.Open(ActiveWorkbook.Path & "\monDocument.doc")     'ouvre le document Word"


    WordDoc.Tables(1).Columns(2).Cells(2).Range.Text = Range("C2")
    WordDoc.Tables(1).Columns(4).Cells(2).Range.Text = Range("A2")
    WordDoc.Tables(1).Columns(5).Cells(2).Range.Text = Range("B2")
    WordDoc.Tables(1).Columns(6).Cells(2).Range.Text = Range("G2")
    WordDoc.Tables(1).Columns(7).Cells(2).Range.Text = Range("H2")
    WordDoc.Tables(1).Columns(8).Cells(2).Range.Text = Range("K2")
    
    WordDoc.Tables(1).Columns(2).Cells(3).Range.Text = Range("C3")
    WordDoc.Tables(1).Columns(4).Cells(3).Range.Text = Range("A3")
    WordDoc.Tables(1).Columns(5).Cells(3).Range.Text = Range("B3")
    WordDoc.Tables(1).Columns(6).Cells(3).Range.Text = Range("G3")
    WordDoc.Tables(1).Columns(7).Cells(3).Range.Text = Range("H3")
    WordDoc.Tables(1).Columns(8).Cells(3).Range.Text = Range("K3")
    
    WordDoc.Tables(1).Columns(2).Cells(4).Range.Text = Range("C4")
    WordDoc.Tables(1).Columns(4).Cells(4).Range.Text = Range("A4")
    WordDoc.Tables(1).Columns(5).Cells(4).Range.Text = Range("B4")
    WordDoc.Tables(1).Columns(6).Cells(4).Range.Text = Range("G4")
    WordDoc.Tables(1).Columns(7).Cells(4).Range.Text = Range("H4")
    WordDoc.Tables(1).Columns(8).Cells(4).Range.Text = Range("K4")
    
    End Sub

Besoin d'aide pr finir macro transfert tableau excel vers word

M@tt

XLDnaute Nouveau

Jeremyy

XLDnaute Occasionnel

M@tt

XLDnaute Nouveau

Discussions similaires