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 :
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 |
Le seul probleme est que lorsque je lance cette macro, à un moment donné elle bloque à ce niveau là :
If Not ExisteRep(Rep) Then MkDir Rep
Merci par avance pour votre aide
Partager