Publipostage automatique depuis excel

**Mathsdeb** · 24/05/2015, 08h44

Bonjour à tous,

J'ai trouvé la macro ci-dessous qui permet d'automatiser la tâche de publipostage (j'ai cherché longtemps sur le net..j'ai aussi lu toutes tes slides Heureux-oli mais je n'arrive pas trouver laquelle prendre comme macro.)

J'ai un document principal word et une base de donnée excel (2 onglets : 1 onglet avec la liste des factures fournisseur et un autre onglet avec l'adresse respective de chacun des fournisseurs)

La macro trouvé sur le net est la suivante et je voudrai l'adapter :

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
Public Const wdDefaultFirstRecord = 1
 Public Const wdDefaultLastRecord = -16
 
 
 Sub Publipostage()
 Dim NDXL As String, NDF As String, NDF2 As String, Rep As String
 Dim WordApp As Object ' Word.Application
 Dim WordDoc As Object ' Word.Document
 
     Application.ScreenUpdating = False
 
     NDXL = ActiveWorkbook.Path & "\ESSAI.xlsm"
     NDF = ActiveWorkbook.Path & "\BULL.docx"
     Rep = ActiveWorkbook.Path & "\SousDossier\"
     If Not ExisteRep(Rep) Then MkDir Rep
     NDF2 = Rep & "DocBULL_" & Format(Now(), "yyyymmddhhmm")
 
     Set WordApp = CreateObject("Word.Application")
     WordApp.Visible = False
     Set WordDoc = WordApp.Documents.Open(NDF, ReadOnly:=False)
     With WordDoc.mailMerge
         .OpenDataSource Name:=NDXL, Connection:="Driver={Microsoft Excel Driver (*.xls)};" & _
             "DBQ=" & NDXL & "; ReadOnly=True;", SQLStatement:="SELECT * FROM [Feuil1$]"
         '.Destination = wdSendToPrinter 'Si besoin de fusion vers l'imprimante
         .suppressBlankLines = True
         With .DataSource
             .firstRecord = wdDefaultFirstRecord
             .lastRecord = wdDefaultLastRecord
         End With
         .Execute Pause:=False 'Exécute l'opération de publipostage
     End With
 
     WordDoc.Application.ActiveDocument.SaveAs NDF2
     Set WordDoc = Nothing
     Set WordApp = Nothing
     Application.ScreenUpdating = True
     MsgBox "Publipostage OK"
 End Sub
 
 
 Function ExisteRep(NDF As String) As Boolean
     On Error Resume Next
     ExisteRep = GetAttr(NDF) And vbDirectory
 End Function