Export liste colonne Excel vers Word

Résolu/Fermé

criscrof

Messages postés: 67
Date d'inscription: vendredi 24 octobre 2008
Statut: Membre
Dernière intervention: 26 octobre 2021

- Modifié le 30 mars 2018 à 10:46
criscrof

Messages postés: 67
Date d'inscription: vendredi 24 octobre 2008
Statut: Membre
Dernière intervention: 26 octobre 2021

- 15 juil. 2018 à 16:33

Bonjour,

Voilà mon petit souci. J'ai une macro (procedure) qui me permet d'exporter les données d'un fichier excel (une feuille) vers Word. Je rajoute une deuxième macro pour faire le même travail, mais depuis une autre feuille du même fichier, mais cela ne m'exporte pas toute la colonne (sachant qu'il y a des cellules vides). ça m'exporte uniquement les deux premières cellules qui deplus, contiennent la même référence. J'aimerais pouvoir exporter les données de ma colonne 33 (AG) sans les doublons. J'ai également le petit souci, car quand je lance la deuxième macro, la 1ère ne fonctionne pas... J'aimerais pouvoir exporter les données des deux feuilles, en même temps.

Je pense qu'il manque clairement quelque chose dans ma procedure...

Merci par avance pour votre aide !

1ère macro

Public Sub Export_List()

Dim WordApp As Object
Dim WordDoc As Object

Set WordApp = CreateObject("word.application")
Set WordDoc = WordApp.Documents.Open("Mon doc word")
WordApp.Visible = True

lig1 = 18
While Not IsEmpty(ThisWorkbook.Sheets("Tableaux de Bord").Cells(lig1, 1))
If vale = "" Then
vale = ThisWorkbook.Sheets("Tableaux de Bord").Cells(lig1, 1).Text
Else
vale = vale & Chr(10) & ThisWorkbook.Sheets("Tableaux de Bord").Cells(lig1, 1).Text
End If
lig1 = lig1 + 1
Wend

WordDoc.Bookmarks("Tableau_de_Bord").Range.Text = vale

'WordDoc.Save
'WordDoc.Close

Set WordDoc = Nothing
Set WordApp = Nothing

End Sub

Et la 2ème macro

Public Sub Eport_DLT()

Dim WordApp As Object
Dim WordDoc As Object

Set WordApp = CreateObject("word.application")
Set WordDoc = WordApp.Documents.Open("Mon doc word")
WordApp.Visible = True

lig1 = 6
While Not IsEmpty(ThisWorkbook.Sheets("2018").Cells(lig1, 33))
If vale = "" Then
vale = ThisWorkbook.Sheets("2018").Cells(lig1, 33).Text
Else
vale = vale & Chr(10) & ThisWorkbook.Sheets("2018").Cells(lig1, 33).Text
End If
lig1 = lig1 + 1
Wend

WordDoc.Bookmarks("DLT").Range.Text = vale

'WordDoc.Save
'WordDoc.Close

Set WordDoc = Nothing
Set WordApp = Nothing

End Sub

Merci !

A voir également:

Exporter excel vers word
Export liste colonne Excel vers Word ✓ - Forum - VB / VBA
Exporter un graphique Excel vers Word ✓ - Forum - Excel
Exporter tableau excel vers word - Guide
Exporter liste contact outlook vers excel ✓ - Forum - Outlook
Importation fichier excel dans un document Word - Forum - Excel

3 réponses

Réponse 1 / 3

yg_be

Messages postés: 19514
Date d'inscription: lundi 9 juin 2008
Statut: Contributeur
Dernière intervention: 24 juin 2022

1 127
Modifié le 30 mars 2018 à 11:36

bonjour, pour ton second soucis, je pense qu'il faut retirer les commentaires de save et close.
pour ton premier soucis, les doublons se suivent-ils toujours?

criscrof

Messages postés: 67
Date d'inscription: vendredi 24 octobre 2008
Statut: Membre
Dernière intervention: 26 octobre 2021

30 mars 2018 à 17:00

Bonjour, merci pour ta rapidité de réponse ! Je vais tester en enlevant les lignes mais pourtant ils ne devraient pas être pris dans le code, puisqu'il y a un apostrophe devant. Pour les doublons, oui, ils sesuivent.

yg_be

Messages postés: 19514
Date d'inscription: lundi 9 juin 2008
Statut: Contributeur
Dernière intervention: 24 juin 2022

1 127 > criscrof

Messages postés: 67
Date d'inscription: vendredi 24 octobre 2008
Statut: Membre
Dernière intervention: 26 octobre 2021

Modifié le 30 mars 2018 à 17:33

je voulais suggérer de garder les lignes et de retirer les apostrophes.

Option Explicit

Public Sub Eport_DLT()

Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim ancien As String, nouveau As String, vale As String
Dim lig1 As Long
Dim sh As Worksheet

Set sh = ThisWorkbook.Sheets("2018")
ancien = ""
For lig1 = 6 To sh.UsedRange.Rows(sh.UsedRange.Rows.Count).row
    nouveau = sh.Cells(lig1, 33).Text
    If nouveau <> "" And nouveau <> ancien Then
        If vale = "" Then
            vale = nouveau
        Else
            vale = vale & Chr(10) & nouveau
        End If
    End If
    ancien = nouveau
Next lig1
Set WordApp = New Word.Application
Set WordDoc = WordApp.Documents.Open("Mon doc word")
WordApp.Visible = True
WordDoc.Bookmarks("DLT").Range.Text = vale
WordDoc.Save
WordDoc.Close
Set WordDoc = Nothing
Set WordApp = Nothing

End Sub

criscrof
30 mars 2018 à 17:08

Petite précision : En fait, ça me colle uniquement les deux premières cellules, qui ont la même valeur.

yg_be

Messages postés: 19514
Date d'inscription: lundi 9 juin 2008
Statut: Contributeur
Dernière intervention: 24 juin 2022

1 127 > criscrof
Modifié le 30 mars 2018 à 17:31

sans doute parce que la suivante est vide: tu as écrit ton code pour qu'il s'arrête dès une cellule vide. vois ma suggestion.

criscrof

Messages postés: 67
Date d'inscription: vendredi 24 octobre 2008
Statut: Membre
Dernière intervention: 26 octobre 2021

30 mars 2018 à 22:29

Bonsoir,

Désolé de rpondre tardivement, je viens de tester chez moi. mais sous excel 2013... j'ai la version 2010 au boulot.

Le code s'arrete à la première ligne

Dim WordApp As Word.Application

et ouvre la fenetre : Erreur de compilation : type défini par l'utilisateur non défini.

Réponse 2 / 3

cs_Le Pivert

Messages postés: 7784
Date d'inscription: jeudi 13 septembre 2007
Statut: Contributeur
Dernière intervention: 24 juin 2022

711
31 mars 2018 à 08:37

Bonjour,

voir ceci et lire le 1er commentaire

https://excel.developpez.com/faq/?page=Word#LireChampWord

Réponse 3 / 3

yg_be

Messages postés: 19514
Date d'inscription: lundi 9 juin 2008
Statut: Contributeur
Dernière intervention: 24 juin 2022

1 127
31 mars 2018 à 09:55

petite amélioration:

Option Explicit

Public Sub Eport_DLT()

Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim ancien As String, nouveau As String, vale As String
Dim lig1 As Long
Dim sh As Worksheet

Set sh = ThisWorkbook.Sheets("2018")
ancien = ""
For lig1 = 6 To sh.UsedRange.Rows(sh.UsedRange.Rows.Count).row
    nouveau = sh.Cells(lig1, 33).Text
    If nouveau <> "" And nouveau <> ancien Then
        If vale = "" Then
            vale = nouveau
        Else
            vale = vale & Chr(10) & nouveau
        End If
        ancien = nouveau
    End If
Next lig1
Set WordApp = New Word.Application
Set WordDoc = WordApp.Documents.Open("Mon doc word")
WordApp.Visible = True
WordDoc.Bookmarks("DLT").Range.Text = vale
WordDoc.Save
WordDoc.Close
Set WordDoc = Nothing
Set WordApp = Nothing

End Sub

criscrof

Messages postés: 67
Date d'inscription: vendredi 24 octobre 2008
Statut: Membre
Dernière intervention: 26 octobre 2021

3 avril 2018 à 10:51

Bonjour,

Merci pour tout, mais le souci reste le même. Le code s'arrete à la première ligne
Dim WordApp As Word.Application
et ouvre la fenetre : Erreur de compilation : type défini par l'utilisateur non défini.

Je ne suis pas très câlé en VBA.

La première macro est liée à un bouton, qui se trouve sur ma feuille "Tableau de Bord" et qui me permet d'ourvrir Word et exporter les données, jusque là pas de souci.

La deuxième macro doit récupérer les données d'une autre feuille "2018" (même classeur) et doit les exporter dans le même doc word et en même temps que la première.
Je dois bien la déclarer dans un module, et normalement cela devrait fonctionner avec le même bouton ?

Merci encore pour vos conseils et aides.

yg_be

Messages postés: 19514
Date d'inscription: lundi 9 juin 2008
Statut: Contributeur
Dernière intervention: 24 juin 2022

1 127 > criscrof

Messages postés: 67
Date d'inscription: vendredi 24 octobre 2008
Statut: Membre
Dernière intervention: 26 octobre 2021

3 avril 2018 à 18:35

dans l'éditeur VBA, sans doute menu outils, dans références, il faut ajouter "Microsoft Word xx.x Object Library"

criscrof

Messages postés: 67
Date d'inscription: vendredi 24 octobre 2008
Statut: Membre
Dernière intervention: 26 octobre 2021

3 avril 2018 à 11:05

Peut-être qu'on pourrait faire une requete avec une seule macro ?

cs_Le Pivert

Messages postés: 7784
Date d'inscription: jeudi 13 septembre 2007
Statut: Contributeur
Dernière intervention: 24 juin 2022

711
3 avril 2018 à 18:39

Si il ne lit pas les réponses qui lui sont faites, il ne risque pas d'y arriver!

https://forums.commentcamarche.net/forum/affich-35288167-export-liste-colonne-excel-vers-word#7

criscrof

Messages postés: 67
Date d'inscription: vendredi 24 octobre 2008
Statut: Membre
Dernière intervention: 26 octobre 2021

4 juil. 2018 à 14:41

Bonjour,

Je me rends compte que je n'avais pas dit un "grand merci beaucoup" à toutes vos réponses et conseilles... Désolé pour ce "raté" ! je reviens vers vous car j'aimerais faire une petite modif (un petit plus) dans le code ci-dessus. Je cherche à insérer la suppression des doublons de la colonne (AG ou 33), afin qu'il ne m'exporte pas toute les données dans le fichier Word. Est-ce possible sans réécrire l'ensemble du code ? Ce n'est peut-être pas sorcié, mais je n'y arrive pas.

Merci par avance !

yg_be

Messages postés: 19514
Date d'inscription: lundi 9 juin 2008
Statut: Contributeur
Dernière intervention: 24 juin 2022

1 127 > criscrof

Messages postés: 67
Date d'inscription: vendredi 24 octobre 2008
Statut: Membre
Dernière intervention: 26 octobre 2021

9 juil. 2018 à 10:38

suggestion:

Option Explicit

Public Sub Eport_DLT()

Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim nouveau As String, vale As String
Dim lig1 As Long
Dim sh As Worksheet
Dim vu As New Scripting.Dictionary

Set sh = ThisWorkbook.Sheets("2018")
For lig1 = 6 To sh.UsedRange.Rows(sh.UsedRange.Rows.count).Row
    nouveau = sh.Cells(lig1, 33).text
    If nouveau <> "" And Not vu.Exists(nouveau) Then
        If vale = "" Then
            vale = nouveau
        Else
            vale = vale & Chr(10) & nouveau
        End If
        Call vu.Add(nouveau, 0)
    End If
Next lig1
Set WordApp = New Word.Application
Set WordDoc = WordApp.Documents.Open("Mon doc word")
WordApp.Visible = True
WordDoc.Bookmarks("DLT").Range.text = vale
WordDoc.Save
WordDoc.Close
Set WordDoc = Nothing
Set WordApp = Nothing

End Sub

Il faut que "Microsoft Scripting Runtime" soit présent dans la liste de References de ton projet.

criscrof

Messages postés: 67
Date d'inscription: vendredi 24 octobre 2008
Statut: Membre
Dernière intervention: 26 octobre 2021

10 juil. 2018 à 11:35

Bonjour, j'utilise bien ton code, mais dans mon onglet "TCD" la valeur n'est pas DLT MSM (j'ai bcp lighté le fichier que tu as eu pour des raisons de confidentialités). Mais la macro que j'utilise (ci-dessous) rappatrie les données DIRSP... dans la première section de mon word (que tu peux voir plus haut en image) ou je n'ai pas de doublon dans cette colonne.

A mon avis, je pense que c'est pour cela que ça me prends les doublons. Dans la feuille "TCD", DLT MSM n'est pas dans "étiquettes de lignes", mais dans "étiquettes de colonnes" Il faudrait peut-être que je créé une feuille supplémentaire avec tableau croisé dynamique, en appelant uniquement la colonne concernée, qu'en penses-tu ? Ou alors il y a peut-être d'autres solutions...

Public Sub Export_List()

Dim WordApp As Object
Dim WordDoc As Object

Set WordApp = CreateObject("word.application")
Set WordDoc = WordApp.Documents.Open("Mon document word")
WordApp.Visible = True

lig1 = 18
While Not IsEmpty(ThisWorkbook.Sheets("TCD").Cells(lig1, 1))
    If vale = "" Then
    vale = ThisWorkbook.Sheets("TCD").Cells(lig1, 1).Text
    Else
    vale = vale & Chr(10) & ThisWorkbook.Sheets("TCD").Cells(lig1, 1).Text
    End If
lig1 = lig1 + 1
Wend


WordDoc.Bookmarks("Tableau_de_Bord").Range.Text = vale

'WordDoc.Save
'WordDoc.Close

Set WordDoc = Nothing
Set WordApp = Nothing

End Sub

yg_be

Messages postés: 19514
Date d'inscription: lundi 9 juin 2008
Statut: Contributeur
Dernière intervention: 24 juin 2022

1 127 > criscrof

Messages postés: 67
Date d'inscription: vendredi 24 octobre 2008
Statut: Membre
Dernière intervention: 26 octobre 2021

11 juil. 2018 à 21:46

dans ce cas-là, faisons ainsi:
- supprime la procédure Export_List dans "feuille 12 (Tableau de bord)"
- remplace le contenu de Module1 par:

Option Explicit

Public Sub Export_List()
Dim WordApp As Word.Application
Dim Worddoc As Word.Document

Set WordApp = New Word.Application
Set Worddoc = WordApp.Documents.Open(ThisWorkbook.Path & "\Mon-doc-word.docm")
WordApp.Visible = True

Call Export_TdB(Worddoc)
Call Export_DLT(Worddoc)

Worddoc.Save
Worddoc.Close
Set Worddoc = Nothing
Set WordApp = Nothing

End Sub
Private Sub Export_TdB(Worddoc As Word.Document)

Dim lig1, vale
lig1 = 18
While Not IsEmpty(ThisWorkbook.Sheets("TCD").Cells(lig1, 1))
    If vale = "" Then
    vale = ThisWorkbook.Sheets("TCD").Cells(lig1, 1).Text
    Else
    vale = vale & Chr(10) & ThisWorkbook.Sheets("TCD").Cells(lig1, 1).Text
    End If
lig1 = lig1 + 1
Wend

Worddoc.Bookmarks("Tableau_de_Bord").Range.Text = vale

End Sub
Private Sub Export_DLT(Worddoc As Word.Document)

Dim nouveau As String, vale As String
Dim lig1 As Long
Dim sh As Worksheet
Dim vu As New Scripting.Dictionary

Set sh = ThisWorkbook.Sheets("2018")
For lig1 = 6 To sh.UsedRange.Rows(sh.UsedRange.Rows.Count).Row
    nouveau = sh.Cells(lig1, 33).Text
    If nouveau <> "" And Not vu.Exists(nouveau) Then
        If vale = "" Then
            vale = nouveau
        Else
            vale = vale & Chr(10) & nouveau
        End If
        Call vu.Add(nouveau, 0)
    End If
Next lig1
Worddoc.Bookmarks("DLT").Range.Text = vale

End Sub

- modifie le bouton "generate fsa" pour appeler la routine Export_List

yg_be

Messages postés: 19514
Date d'inscription: lundi 9 juin 2008
Statut: Contributeur
Dernière intervention: 24 juin 2022

1 127 > criscrof

Messages postés: 67
Date d'inscription: vendredi 24 octobre 2008
Statut: Membre
Dernière intervention: 26 octobre 2021

14 juil. 2018 à 19:55

si tu souhaites exporter le contenu du segment DLT MSM, alors je suggère ceci:

Private Sub Export_DLT(Worddoc As Word.Document)
Dim vale As String, nouveau As String
Dim sl As SlicerItem
Dim sc As SlicerCache
Set sc = ThisWorkbook.SlicerCaches("Segment_DLT_MSM")
For Each sl In sc.SlicerItems
    If sl.HasData Then
        nouveau = sl.Name
        If vale = "" Then
            vale = nouveau
        Else
            vale = vale & Chr(10) & nouveau
        End If
    End If
Next sl
Worddoc.Bookmarks("DLT").Range.Text = vale

End Sub

en ce qui concerne ta question en #54 à propos de Word, je suggére que tu postes cela comme une nouvelle question: d'autres t'aideront sans doute mieux que moi à ce sujet.

Newsletters