Sub Mailing()
'Nécessite d'activer la référence "Microsoft Word xx.x Object Library"
Dim docWord As Word.Document
Dim appWord As Word.Application
Dim NomBase As String
Dim MaPlage As Range
NomBase = "C:\Excel\Mailing.xls"
' ***************************************************************
' Export des données vers une feuille Temp ayant O en colonne A
' ****************************************************************
Worksheets.Add().Name = "Temp"
Sheets("Feuil1").Activate
Selection.AutoFilter Field:=1, Criteria1:="O"
Set Destination = ActiveWorkbook.Sheets("Temp").Range("A1")
Set MaPlage = Sheets("Feuil1").AutoFilter.Range
Set MaPlage = MaPlage.Offset(0, 0).Resize(MaPlage.Rows.Count, MaPlage.Columns.Count)
MaPlage.Copy Destination
Selection.AutoFilter
' ******************************************
' Début du mailing
' ******************************************
Application.ScreenUpdating = False
Set appWord = New Word.Application
appWord.Visible = True
'Ouverture du document principal Word
Set docWord = appWord.Documents.Open("C:\Excel\Mailing.doc")
'Fonctionnalité de publipostage pour le document spécifié
With docWord.mailMerge
'Ouvre la base de données
.OpenDataSource Name:=NomBase, _
Connection:="Driver={Microsoft Excel Driver (*.xls)};" & _
"DBQ=" & NomBase & "; ReadOnly=True;", _
SQLStatement:="SELECT * FROM [Temp$]"
'Spécifie la fusion vers l'imprimante
.Destination = wdSendToPrinter
.suppressBlankLines = True
'Prend en compte l'ensemble des enregistrements
With .DataSource
.firstRecord = wdDefaultFirstRecord
.lastRecord = wdDefaultLastRecord
End With
'Exécute l'opération de publipostage
.Execute Pause:=False
End With
Application.ScreenUpdating = True
'Fermeture du document Word
docWord.Close False
appWord.Quit
' ***************************************
' Suppression de la feuille temporaire
' ***************************************
Sheets("Temp").Select
ActiveWindow.SelectedSheets.Delete
End Sub