Export d'un tableau Excel vers Word

Version imprimable

Bonjour à tous,

Je viens à nouveau sollicité votre aide...
Donc voilà, j'ai un tableau Excel avec 13 colonnes et environ 200 lignes...
Grâce à une macro, j'arrive à l'exporter dans Word avec une nouvelles mises en page et en faisant une sélection de colonnes.

Cependant, cela fonctionne avec toutes les lignes mais j'aimerai bien que, par exemple dans mon tableau Word, il me mette les données des lignes 12 à 23...

Pour cela, j'ai fait un petit formulaire ou je rentre la ligne de début et la ligne de fin mais après je suis perdu...

Ma macro :

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Dim wordApp As Word.Application
Dim wordDoc As Word.Document
Dim LL, L As Integer
Dim txt As String
 
Dim debut, fin As Integer
debut = UserForm1.debut.Text
fin = UserForm1.fin.Text
 
'MsgBox (debut)
'MsgBox (fin)
 
Set wordApp = CreateObject("word.application")
LL = Sheets("Feuil1").Range("A65536").End(xlUp).Row + 1
 
wordApp.Visible = True
Set wordDoc = wordApp.Documents.Open(ThisWorkbook.Path & "\tableau_pour_impression.doc")
 
'Vide le tableau 1
For L = 2 To 35
wordDoc.Tables(1).Columns(1).Cells(L).Range.Text = ""
wordDoc.Tables(1).Columns(2).Cells(L).Range.Text = ""
wordDoc.Tables(1).Columns(3).Cells(L).Range.Text = ""
wordDoc.Tables(1).Columns(4).Cells(L).Range.Text = ""
wordDoc.Tables(1).Columns(5).Cells(L).Range.Text = ""
wordDoc.Tables(1).Columns(6).Cells(L).Range.Text = ""
wordDoc.Tables(1).Columns(7).Cells(L).Range.Text = ""
wordDoc.Tables(1).Columns(8).Cells(L).Range.Text = ""
wordDoc.Tables(1).Columns(9).Cells(L).Range.Text = ""
wordDoc.Tables(1).Columns(10).Cells(L).Range.Text = ""
 
Next L
 
For L = 2 To LL + 1
wordDoc.Tables(1).Columns(1).Cells(L).Range.Text = DateValue(Now)
wordDoc.Tables(1).Columns(2).Cells(L).Range.Text = Range("B" & L)
wordDoc.Tables(1).Columns(3).Cells(L).Range.Text = Range("C" & L)
wordDoc.Tables(1).Columns(4).Cells(L).Range.Text = Range("E" & L)
wordDoc.Tables(1).Columns(5).Cells(L).Range.Text = "né(e) le"
wordDoc.Tables(1).Columns(6).Cells(L).Range.Text = Range("F" & L)
wordDoc.Tables(1).Columns(7).Cells(L).Range.Text = Range("K" & L)
wordDoc.Tables(1).Columns(8).Cells(L).Range.Text = Range("J" & L)
 
Next L
 
 
End Sub

Merci d'avance !

07/11/2008, 13h38
ouskel'n'or

Tu as plusieurs réponses sur le forum Contribuez d'Excel. Un exemple
http://www.developpez.net/forums/d37...document-word/
Bon week-end
07/11/2008, 13h48
Flo88

J'avais vu ce tuto mais je n'ai pas réussi à m'en servir pour l'implanter dans mon code...

Si quelqu'un pouvait m'aider à directement changer ce qu'il faut dans mon code existant..
11/11/2008, 21h20
Flo88

Toujours pas trouvé...
je pense opter poutr une boucle "pour" mais après je ne c point
j'ai testé aec le range...
11/11/2008, 21h43
Godzestla

Bonsoir Flo88,

tu peux trouver de l'inspiration ici

Bonjour à tous,

Juste ce petit message pour dire que je n'ai toujours pas réussi à résoudre mon problème...

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Private Sub CommandButton3_Click()
 
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
 
Set WordApp = CreateObject("word.application")
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Open(ThisWorkbook.Path & "\tableau_pour_impression.doc")
 
Dim debut, boucle_pour, L, LL, M, fin, diff, plage As Integer
Dim cellule, cellule_debut As String
 
 
debut = UserForm1.debut.Text
fin = UserForm1.fin.Text
diff = (fin + 1) - (debut - 1)
plage = fin + 1
cellule = "A" & plage & ""
 
cellule_debut = "A" & debut & ""
 
'MsgBox (cellule)
 
 
 
LL = Sheets("Feuil1").Range(cellule).End(xlUp).Row + 1
 
'MsgBox (LL)
 
For boucle_pour = 1 To diff - 2
    WordDoc.Tables(1).Rows.Add
Next boucle_pour
 
For L = debut To LL
    WordDoc.Tables(1).Columns(1).Cells(L).Range.Text = DateValue(Now)
    WordDoc.Tables(1).Columns(2).Cells(L).Range.Text = Range("C" & L)
    WordDoc.Tables(1).Columns(3).Cells(L).Range.Text = Range("D" & L)
    WordDoc.Tables(1).Columns(4).Cells(L).Range.Text = Range("E" & L)
    WordDoc.Tables(1).Columns(5).Cells(L).Range.Text = Range("F" & L)
    WordDoc.Tables(1).Columns(6).Cells(L).Range.Text = Range("K" & L)
    WordDoc.Tables(1).Columns(7).Cells(L).Range.Text = Range("J" & L)
Next L

Avec ce code, il me créer bien le nombre de lignes que j'ai besoin mais ne copie pas les bonnes cellules...

Ma form me permets de sélectionner ma ligne de début et ma ligne. Par exemple :
Ligne de début : 18
Ligne de fin : 21
Donc il faudrait que je travail sur cette plage de cellule entre A18 et A21 d'où le :

Code:

LL = Sheets("Feuil1").Range(cellule).End(xlUp).Row + 1

mais je reste bloqué depuis bientôt un mois là dessus 8O8O8O

Merci de votre aide

26/01/2009, 11h53
Godzestla

Bonjour,
as-tu essayé ma proposition ?
Je l'utilise et elle fonctionne plutôt bien !
26/01/2009, 12h01
ouskel'n'or

Bonjour Flo88,
Le tableau que tu as dans Word semble ne pas reproduire la structure de la plage de cellules que tu reportes ?
Ex : Tu souhaites reporter la plage "A18:K21" dans le tableau Word mais, dans Word, les colonnes sont déplacées.
- Est-ce bien ce qui pose problème ?
- Est-ce seulement ça ?

Si oui, la solution que je vois est de déplacer tes colonnes dans Excel, d'effectuer une copie de la plage qui t'intéresse et de la coller dans Word. Une fois fait on ferme le classeur sans enregistrer. C'est le plus simple. Il est plus simple de faire ça dans Excel que dans Word.
Sinon ça devient vite l'usine à gaz.
Si on ne peut pas faire autrement, il sera toujours temps de passer à la raffinerie de pétrole plus tard mais en attendant, si tu peux répondre...

2 pièce(s) jointe(s)

En fait, mon fichier Excel comporte 13 colonnes mais seulement quelques une sont à exporter vers Word... Après, certaines cellules dans le tableaux Word sont vides et destiné à être des signatures...

La procédure suivante fonctionne bien pour toutes les cellules. Je pense qu'il faudrait trouver comment modifier la boucle Pour...
Code:

1 2 3 4 5 6 7 8 9 10 11 12 LL = Sheets("Feuil1").Range("A65536").End(xlUp).Row + 1 For L = 2 To LL + 1 WordDoc.Tables(1).Columns(1).Cells(L).Range.Text = DateValue(Now) WordDoc.Tables(1).Columns(2).Cells(L).Range.Text = Range("C" & L) WordDoc.Tables(1).Columns(3).Cells(L).Range.Text = Range("D" & L) WordDoc.Tables(1).Columns(4).Cells(L).Range.Text = Range("E" & L) WordDoc.Tables(1).Columns(5).Cells(L).Range.Text = Range("F" & L) WordDoc.Tables(1).Columns(6).Cells(L).Range.Text = Range("K" & L) WordDoc.Tables(1).Columns(7).Cells(L).Range.Text = Range("J" & L) Next L
Citation:

Envoyé par Godzestla

Bonjour,
as-tu essayé ma proposition ?
Je l'utilise et elle fonctionne plutôt bien !

j'ai regardé mais il ne me semble pas que cela correspondrait...

Ci joint deux captures d'écran qui pourraient aider à comprendre

Hello,
Pour tester le code, j'ai fait ça sans utiliser d'userform et donc en fixant la plage de données en dur dans la procédure.
Chez moi le code suivant fonctionne. J'espère qu'il en sera de même chez toi.
Dans Word, je place les données à partir de la seconde ligne, soupçonnant que tu souhaites ajouter un en-tête de colonne.

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
28
29
30
31
32
33
34
35
36
37
38
39
Private Sub CommandButton3_Click()
 
Dim WordApp As Object
Dim WordDoc As Object
Dim debut As Integer, fin As Integer, diff As Integer, NbCol As Integer
Dim FL1 As xorksheet
    Set FL1 = Worksheets("feuil1") 'La feuille lue dans le classeur Excel
    Set WordApp = CreateObject("word.application")
    WordApp.Visible = True
    Set WordDoc = WordApp.Documents.Add
 
    debut = 18 'ligne incluse
    fin = 21   'Dernière ligne
    diff = (fin + 1) - (debut - 1)
    NbCol = 7
 
    Dim Tablo As Object, NoLig As Long
    'Création du tableau en fonction du nb de lignes de la plage + 1 pour l'en-tête
    Set Tablo = WordDoc.Tables.Add(Range:=WordApp.Selection.Range, NumRows:=diff, NumColumns:=NbCol)
 
    For NoLig = 18 To 21
        With Tablo
            .Columns(1).Cells(NoLig - debut + 2).Range.Text = DateValue(Now)
            .Columns(2).Cells(NoLig - debut + 2).Range.Text = FL1.Range("C" & NoLig)
            .Columns(3).Cells(NoLig - debut + 2).Range.Text = FL1.Range("D" & NoLig)
            .Columns(4).Cells(NoLig - debut + 2).Range.Text = FL1.Range("E" & NoLig)
            .Columns(5).Cells(NoLig - debut + 2).Range.Text = FL1.Range("F" & NoLig)
            .Columns(6).Cells(NoLig - debut + 2).Range.Text = FL1.Range("K" & NoLig)
            .Columns(7).Cells(NoLig - debut + 2).Range.Text = FL1.Range("J" & NoLig)
        End With
    Next NoLig
 
    'Pour débugger ******************************************************************************
    Stop ' Permet de vérifier le résultat dans Word *** Ctrl + F8 permet de continuer l'exécution
 
    WordDoc.Close False 'ferme le fichier word créé sans l'enregistrer
    WordApp.Quit ' pas oublier !
 
End Sub

Tu n'as plus qu'à ajouter le code pour récupérer debut et fin, voire le nombre de colonnes... mais pour la selection, j'utiliserais Inputbox("...",type:=8) qui faciliterait la visualistion de cette sélection de la part des utilisateurs.
Bon après-midi

Merci de ton aide... Cependant, au lieu de créer un nouveau doc, serait-il possible d'utiliser le word déjà existant... Dans mon ancien code, cela correspondait à ca :
Code:

1 2 3 4 5 6 7 8 Set WordApp = CreateObject("word.application") WordApp.Visible = True Set WordDoc = WordApp.Documents.Open(ThisWorkbook.Path & "\tableau_pour_impression.doc") For boucle_pour = 1 To diff - 2 WordDoc.Tables(1).Rows.Add Next boucle_pour
Grâce à ca j'obtenais le bon tableau, avec le bon nombre de lignes, etc... Pour les entetes de colonnes, je ne m'en occupe pas vu que je l'ai est mi dans l'en tete de la page comme ça s'il y a plusieurs pages à imprimer, les tetes de colonnes sont sur chaque pages...

Yes merci à tous cela fonctionne :

Voici le code final :

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Dim WordApp As Object
Dim WordDoc As Object
 
Dim debut As Integer, fin As Integer, diff As Integer, NbCol As Integer
 
Dim FL1 As Worksheet
 
    Set FL1 = Worksheets("Feuil1") 'La feuille lue dans le classeur Excel
    Set WordApp = CreateObject("word.application")
    WordApp.Visible = True
    Set WordDoc = WordApp.Documents.Open(ThisWorkbook.Path & "\tableau_pour_impression.doc")
 
 
    debut = UserForm1.debut.Text 'ligne incluse
    fin = UserForm1.fin.Text   'Dernière ligne
    diff = (fin + 1) - (debut - 1)
    NbCol = 9
 
    For boucle_pour = 1 To diff - 2
    WordDoc.Tables(1).Rows.Add
        Next boucle_pour
 
 
 
    Dim Tablo As Object, NoLig As Long
    'Création du tableau en fonction du nb de lignes de la plage + 1 pour l'en-tête
    'Set Tablo = WordDoc.Tables.Add(Range:=WordApp.Selection.Range, NumRows:=diff, NumColumns:=NbCol)
    Set Tablo = WordDoc.Tables(1)
 
 
    For NoLig = debut To fin + 1
        With Tablo
            .Columns(1).Cells(NoLig - debut + 1).Range.Text = DateValue(Now)
            .Columns(2).Cells(NoLig - debut + 1).Range.Text = FL1.Range("C" & NoLig)
            .Columns(3).Cells(NoLig - debut + 1).Range.Text = FL1.Range("D" & NoLig)
            .Columns(4).Cells(NoLig - debut + 1).Range.Text = FL1.Range("E" & NoLig)
            .Columns(5).Cells(NoLig - debut + 1).Range.Text = FL1.Range("F" & NoLig)
            .Columns(6).Cells(NoLig - debut + 1).Range.Text = FL1.Range("K" & NoLig)
            .Columns(7).Cells(NoLig - debut + 1).Range.Text = FL1.Range("J" & NoLig)
        End With
    Next NoLig

Encore Merci...

26/01/2009, 15h39
ouskel'n'or

Hello Flo,
N'oublie pas le clic sur :resolu: en bas de cette fenêtre ;)