Sub PublipostageLDM()
Dim DerLig As Long
Dim NDF As String, NDF2 As String
Dim VPathD As String ' Répertoire de destination des courries
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim Chemin As String
'VPathD = "\" ' Pour TEST
VPathD = "\Documents\Lettre de mission\"
' Récupérer le nom de la lettre type WORD dans la cellule A1 de la feuille CODE
NDF = ActiveWorkbook.Path & "\" & Sheets("CODE").Range("A1")
' Vérifier si le nom du fichier contient l'extension
If Right(NDF, 4) <> ".doc" Then NDF = NDF & ".doc"
' Récupérer le nom de sauvegarde du fichier WORD
NDF2 = ActiveWorkbook.Path & VPathD & Sheets("PUBLIPOSTAGELDM").Range("A2").Text & ".doc"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Chemin = ActiveWorkbook.Path
' ***** INFOS IMPORTANTES ***************************************************
' 1) Définir la plage des données pour éviter les page vides
'
' 2) Export des données dans un classeur temporaire pour éviter d'avoir
' une instance Excel qui reste dans la Liste des Tâches
' C'est ce document temporaire qui sera utilisé par Word lors de la fusion et
' évitera les inconvénients cités plus haut.
' ---------------------------------------------------------------------------
With Sheets("PUBLIPOSTAGELDM")
' Trouver la dernière ligne
DerLig = .Range("A" & Rows.Count).End(xlUp).Row
' Copier la feuille ans un nouveau classeur
.Copy
End With
' Définir la plage de données remplie de la ligne1/colonne1 à la dernière ligne/colonne25
' Permet d'éviter d'imprimer des lignes vides au publipostage
[COLOR=Blue]ActiveWorkbook.Names.Add Name:="BdD", RefersToR1C1:="=PUBLIPOSTAGELDM!R1C1:R" & DerLig & "C25"[/COLOR]
' Sauvegarder le nouveau classeur sous nom TEMPoraire
ActiveWorkbook.SaveAs Chemin & "\Temp.xls"
' Fermer le classeur
ActiveWorkbook.Close SaveChanges:=False
' ***************************************************************************
' Ouverture de Word
Set WordApp = New Word.Application
'Application.ScreenUpdating = False
WordApp.Visible = True 'False 'True
Set WordDoc = WordApp.Documents.Open(NDF, ReadOnly:=False)
' Ouverture de la base de données, passage des paramètres
' pour la requête et lancement du Publipostage
With WordDoc.MailMerge
' Si le fichier Excel n'est pas déjà lié dans le fichier Word
.OpenDataSource Name:=Chemin & "\Temp.xls", ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
Format:=wdOpenFormatAuto, _
Connection:="Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & Chemin & "\Temp.xls;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet ", _
SQLStatement:="SELECT * FROM `[B][COLOR=Blue]BdD[/COLOR][/B]`", SQLStatement1:="", SubType:=wdMergeSubTypeAccess
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
'Exécute l'opération de publipostage
.Execute Pause:=False
End With
' Sauvegarder le document de Publipostage et fermeture
WordDoc.Application.ActiveDocument.SaveAs NDF2
WordApp.ActiveDocument.Close ' Fermer le document de publipostage
WordDoc.Close SaveChanges = False ' Fermer la lettre type
WordApp.Quit ' Quitter Word
Set WordDoc = Nothing
Set WordApp = Nothing
' Activation de l'onglet
Sheets("PUBLIPOSTAGELDM").Select
' Effacement du fichier temporaire crée spécialement pour la fusion
Kill Chemin & "\temp.xls"
End Sub