Publipostage Word avec données Excel

Le 02/07/2023 à 15:41

Bonjour à tout le forum,

Je suis à la recherche d'un moyen pour pouvoir créer un fichier Word depuis une base de données EXCEL.

J'ai lu des sujets sur le publipostage mais avec des fichiers Word déjà pré-renseignés. Dans mon cas je voudrais renseigner un fichier Word vierge.

J'ai donc commencé à écrire la macro qui est appelée par le bouton bleu sur la feuille "Index"

Par contre je n'arrive pas à remplir le fichier Word avec mes données EXCEL

Voici ce que je souhaite réaliser :

1) Écrire en en-tête du fichier Word le texte contenu en cellule A1 de la feuille Index

2) Ajouter un tableau pour chaque feuille scrutée et y afficher les données présentes en cellules A1, D2 et A5.

Pour mieux expliquer ma demande, je poste mon fichier EXCEL ainsi qu'un fichier WORD qui reflète le résultat attendu. Si vous avez d'autres propositions de présentations sur WORD je suis preneur !

Merci beaucoup à celles et ceux qui pourront me venir en aide !

JB

20jb.xlsm (17.22 Ko)
13liste-des-emplacements.docx (13.81 Ko)
Le 07/07/2023 à 15:14

Bonjour,

Option Explicit

Sub EcrireDansWord()

Dim I As Long
Dim Onglets As Sheets
' Dim WdApp As Word.Application, WdDoc As Word.Document, WdSel As Word.Selection
Dim WdApp As Object, WdDoc As Object, WdSel As Object
Dim Chemin As String

    With ActiveWorkbook
         Set Onglets = .Sheets
         Chemin = .Path
    End With

    Set WdApp = CreateObject("Word.Application")
    With WdApp
         .Visible = True
         Set WdDoc = .Documents.Add
         Set WdSel = .Selection
    End With

    With WdDoc
         With .Sections(1).Headers.Item(1).Range
              .Text = Onglets("Index").Range("A1")
              .ParagraphFormat.Alignment = 1
              .Style.Font.Bold = True
              .Style.Font.Size = 14
         End With
    End With
    WdSel.EndKey unit:=6  'wdStory

    For I = 1 To Onglets.Count
        Select Case Onglets(I).Name
               Case "Index"

               Case Else
                    With Onglets(I)
                         GenererUnTableau WdApp, WdDoc, WdSel, "Ville : " & .Range("A1"), "Structure : " & .Range("D2"), .Range("A5")
                    End With
        End Select
    Next I

    With WdDoc
         .SaveAs2 Filename:=Chemin & "\Essais\Publipostage " & GroupeDateHeure, FileFormat:=12 ' Si sauvegarde en .docx
         .Close
    End With

    WdApp.Quit

    Set WdSel = Nothing: Set WdDoc = Nothing: Set WdApp = Nothing
    Set Onglets = Nothing

End Sub

'Sub GenererUnTableau(ByVal WdApp2 As Word.Application, ByVal WdDoc2 As Word.Document, ByVal WdSel2 As Word.Selection, ByVal Cellule1 As String, ByVal Cellule2 As String, ByVal Cellule3 As String)
Sub GenererUnTableau(ByVal WdApp2 As Object, ByVal WdDoc2 As Object, ByVal WdSel2 As Object, ByVal Cellule1 As String, ByVal Cellule2 As String, ByVal Cellule3 As String)

Dim MaTable As Object 'Word.Table

    WdSel2.EndKey unit:=6 'wdStory

    With WdDoc2

        Set MaTable = .Tables.Add(Range:=WdSel2.Range, NumRows:=2, NumColumns:=2)
        With MaTable
             .Rows(2).Cells.Merge
             With .Borders
                  .OutsideLineStyle = 1 'wdLineStyleSingle
                  .InsideLineStyle = 1 'wdLineStyleSingle
             End With
            With .Range
                 With .Cells(1)
                      .Range.Text = Cellule1
                      .Range.ParagraphFormat.SpaceAfter = 0
                 End With
                 With .Cells(2)
                      .Range.Text = Cellule2
                      .Range.ParagraphFormat.SpaceAfter = 0
                 End With
                 With .Cells(3)
                     .Range.Text = "Commentaire :" & Chr(10) & Cellule3 & Chr(10)
                     .Range.ParagraphFormat.SpaceAfter = 0
                 End With
            End With
        End With
        Set MaTable = Nothing

        With WdSel2
             .EndKey unit:=6 'wdStory
             .Paragraphs.Add
        End With

  End With

End Sub

Function GroupeDateHeure() As String

Dim HeureEnCours As Variant

    HeureEnCours = Split(Time, ":")
    GroupeDateHeure = Year(Date) & "-" & Format(Month(Date), "00") & "-" & Format(Day(Date), "00") & " " & Join(HeureEnCours, "-")

End Function
Le 07/07/2023 à 18:39

Bonsoir Eric Kergresse,

Merci beaucoup, excellent travail !!!! Cela répond exactement à mes attentes :)

Petite question: Savez-vous s'il y a moyen d'insérer un saut de ligne juste avant la création d'un nouveau tableau afin d'éviter qu'il se retrouve sur 2 pages dans le cas où il y aurait plusieurs pages?

Si ce n'est pas possible, ce n'est pas grave c'est déjà très très très bien !

Encore un grand merci !

JB

Le 07/07/2023 à 18:54

Il faudrait déterminer la hauteur d'une page et calculer la position relative dans la page à chaque nouveau tableau, puis insérer un saut de page juste avant le tableau qui va se trouver entre deux pages.

Pour cela, il faut vous servir de la propriété Information :

    Debug.Print Selection.Information(6) ' (wdVerticalPositionRelativeToPage)

Voir les différentes informations pouvant être recueillies dans l'aide en ligne VBA Word. Il suffit de taper wdVerticalPositionRelativeToPage dans le champ recherche.

Le 09/07/2023 à 11:12

Bonjour Eric,

Merci je vais regarder cela même si cela semble assez fastidieux vu mon niveau VBA, je reviendrai sur ce sujet si je galère trop !

Merci beaucoup !

JB

Le 09/07/2023 à 13:05

Bonjour Jean-Baptiste,

Chez moi une page fait 753,6 points de hauteur, un tableau 81,6 points de haut.

NbTableaux est une variable de portée public, elle est initialisée dans l'autre procédure. Elle n'est pas nécessaire pour le fonctionnement.

Sub GenererUnTbleau(ByVal WdApp2 As Object, ByVal WdDoc2 As Object, ByVal WdSel2 As Object, ByVal Cellule1 As String, ByVal Cellule2 As String, ByVal Cellule3 As String)

Dim MaTable As Object 'Word.Table

    WdSel2.EndKey unit:=6 'wdStory

    With WdDoc2

        Set MaTable = .Tables.Add(Range:=WdSel2.Range, NumRows:=2, NumColumns:=2)
        With MaTable
             .Rows(2).Cells.Merge
             With .Borders
                  .OutsideLineStyle = 1 'wdLineStyleSingle
                  .InsideLineStyle = 1 'wdLineStyleSingle
             End With
            With .Range
                 With .Cells(1)
                      .Range.Text = Cellule1
                      .Range.ParagraphFormat.SpaceAfter = 0
                 End With
                 With .Cells(2)
                      .Range.Text = Cellule2
                      .Range.ParagraphFormat.SpaceAfter = 0
                 End With
                 With .Cells(3)
                     .Range.Text = "Commentaire :" & Chr(10) & Cellule3 & Chr(10)
                     .Range.ParagraphFormat.SpaceAfter = 0
                 End With
            End With
        End With
        Set MaTable = Nothing

        With WdSel2
             .EndKey unit:=6 'wdStory
             .Paragraphs.Add
             Debug.Print "Position tableau " & NbTableaux & " : " & .Information(6)
             If .Information(6) + 81.6 > 753.6 Then
                .InsertBreak Type:=7  'wdPageBreak
             End If
             NbTableaux = NbTableaux + 1
        End With

  End With

End Sub
Le 09/07/2023 à 15:07

Bonjour Eric,

Merci beaucoup pour votre contribution mais en fait, la taille de chaque tableau peut évoluer à la hausse si le texte mis en commentaire est long.

Après avoir fait un essai, il y a des sauts de page une fois sur deux. Sinon ce n'est pas grave, je vais rester sur votre 1 ère proposition de code, mes collaborateurs n'auront qu'à mettre les feuilles imprimées à la suite en superposant les marges.

Merci à vous en tout cas :)

JB

Le 09/07/2023 à 15:42

Si les tableaux ont des hauteurs différentes, il faudrait faire un balayage pour générer les sauts de page, une fois tous les tableaux créés et en tenant compte de leur hauteur.

Le 09/07/2023 à 15:48

Eric,

Excellente idée !!! Par contre le nombre de tableaux varie ainsi que leurs tailles. Mes connaissances en VBA sont trop faibles pour parvenir à composer ce code.

Auriez-vous la possibilité de me venir en aide svp ?

Un immense merci :)

JB

Rechercher des sujets similaires à "publipostage word donnees"