Export liste colonne Excel vers Word

Résolu
criscrof Messages postés 71 Statut Membre -  
criscrof Messages postés 71 Statut Membre -
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

Résumé de la discussion

Le problème porte sur l'exportation de données d'une feuille Excel vers Word via deux macros distinctes, avec des cellules vides qui font sauter des lignes et des doublons non souhaités. Des conseils suggèrent d'éviter les doublons en ne conservant que les valeurs distinctes, par exemple en comparant les valeurs consécutives avec des variables ancien et nouveau, et d'activer Option Explicit. Les scripts exportent à partir de la feuille 'Tableaux de Bord' dès la ligne 18 et de '2018' dès la ligne 6, puis remplissent les signets 'Tableau_de_Bord' et 'DLT'. D'autres proposent d'échanger les données via une procédure qui reçoit le document Word en paramètre et d'éviter de relancer Word entre les feuilles, en utilisant une boucle For sur UsedRange.

Bobot (l'IA à votre service)
  1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    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
    1. criscrof Messages postés 71 Statut Membre
       
      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.
      0
      1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588 > criscrof Messages postés 71 Statut Membre
         
        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
        0
    2. criscrof
       
      Petite précision : En fait, ça me colle uniquement les deux premières cellules, qui ont la même valeur.
      0
      1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588 > 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.
        0
    3. criscrof Messages postés 71 Statut Membre
       
      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.
      0
  3. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    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
    1. criscrof Messages postés 71 Statut Membre
       
      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.
      0
    2. criscrof Messages postés 71 Statut Membre
       
      Peut-être qu'on pourrait faire une requete avec une seule macro ?
      0
    3. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588 > criscrof Messages postés 71 Statut Membre
       
      dans l'éditeur VBA, sans doute menu outils, dans références, il faut ajouter "Microsoft Word xx.x Object Library"
      0
    5. criscrof Messages postés 71 Statut Membre
       
      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 !
      0