Export liste colonne Excel vers Word [Résolu/Fermé]

Signaler
Messages postés
63
Date d'inscription
vendredi 24 octobre 2008
Statut
Membre
Dernière intervention
1 avril 2020
-
Messages postés
63
Date d'inscription
vendredi 24 octobre 2008
Statut
Membre
Dernière intervention
1 avril 2020
-
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 !


3 réponses

Messages postés
14287
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
22 février 2021
804
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?
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 65492 internautes nous ont dit merci ce mois-ci

Messages postés
63
Date d'inscription
vendredi 24 octobre 2008
Statut
Membre
Dernière intervention
1 avril 2020

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.
Messages postés
14287
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
22 février 2021
804 >
Messages postés
63
Date d'inscription
vendredi 24 octobre 2008
Statut
Membre
Dernière intervention
1 avril 2020

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
Petite précision : En fait, ça me colle uniquement les deux premières cellules, qui ont la même valeur.
Messages postés
14287
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
22 février 2021
804 > criscrof
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.
Messages postés
63
Date d'inscription
vendredi 24 octobre 2008
Statut
Membre
Dernière intervention
1 avril 2020

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.
Messages postés
7268
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
22 février 2021
616
Bonjour,

voir ceci et lire le 1er commentaire

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

1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 65492 internautes nous ont dit merci ce mois-ci

Messages postés
14287
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
22 février 2021
804
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
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 65492 internautes nous ont dit merci ce mois-ci

Messages postés
63
Date d'inscription
vendredi 24 octobre 2008
Statut
Membre
Dernière intervention
1 avril 2020

Du coup, j'ai pu faire un essai avec les filtres, ça fonctionne très bien ! Merci beaucoup ! Juste deux petites choses si je peux me permettre. La première est, ce que je te demande dans le post ci-dessus #54 pour le doc word. La deuxième chose, j'ai filtré (voir pj) via mon tableau de bord 1er segment en haut à gauche) et il me sort toute la liste des DLT (sans les doublons bien sûr maintenant) mais j'aurai souhaité qu'il me colle uniquement les DLT filtrées c'est à dire seulement les deux du segment DLT MSM, c'est possible ? Merci !

Messages postés
14287
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
22 février 2021
804 >
Messages postés
63
Date d'inscription
vendredi 24 octobre 2008
Statut
Membre
Dernière intervention
1 avril 2020

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.
Messages postés
63
Date d'inscription
vendredi 24 octobre 2008
Statut
Membre
Dernière intervention
1 avril 2020

Bonjour,
La macro fonctionne très bien.
Je te remercie beaucoup pour ce très gros coup de main, ainsi que la patience que tu as pu avoir pour répondre à l'ensemble des questions posées... J'espère pouvoir à mon, un jour te rendre la "pareille" ! Sur Visual, ça risque d'être plus dur de rivaliser. En attendant à nouveau merci pour la transmission de tes compétences ! Bravo
A bientôt !
Messages postés
14287
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
22 février 2021
804 >
Messages postés
63
Date d'inscription
vendredi 24 octobre 2008
Statut
Membre
Dernière intervention
1 avril 2020

content d'avoir pu t'aider. peux-tu marquer le sujet comme résolu, via la roue dentée à droite du titre?
Messages postés
63
Date d'inscription
vendredi 24 octobre 2008
Statut
Membre
Dernière intervention
1 avril 2020

oui bien sûr ! Merci encore