Export d'un tableau Excel vers Word

**Flo88** · 07/11/2008, 13h16

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 !

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

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

**Flo88** · 07/11/2008, 13h48

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..

**Flo88** · 11/11/2008, 21h20

Toujours pas trouvé...
je pense opter poutr une boucle "pour" mais après je ne c point
j'ai testé aec le range...

**Godzestla** · 11/11/2008, 21h43

Bonsoir Flo88,

tu peux trouver de l'inspiration ici

**Flo88** · 26/01/2009, 11h39

Bonjour à tous,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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

Merci de votre aide

**Godzestla** · 26/01/2009, 11h53

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

**ouskel'n'or** · 26/01/2009, 12h01

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...

**Flo88** · 26/01/2009, 13h53

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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

**ouskel'n'or** · 26/01/2009, 14h47

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Flo88** · 26/01/2009, 15h10

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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...

**Flo88** · 26/01/2009, 15h30

Yes merci à tous cela fonctionne :

Voici le code final :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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...

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

Hello Flo,
N'oublie pas le clic sur

en bas de cette fenêtre

Export d'un tableau Excel vers Word

Macros et VBA Excel

Discussions similaires

Partager

Partager