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 45 46
| Sub Publipostage()
'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
'Indique le chemin du classeur excel
NomBase = ThisWorkbook.FullName
Application.ScreenUpdating = False
Set appWord = New Word.Application
appWord.Visible = True
'Ouverture du document principal Word, doit être dans même dossier
Set docWord = appWord.Documents.Open(ThisWorkbook.Path & "\EtiquetteCodeBarre.docx")
'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 (*.xlsm)};" & _
"DBQ=" & NomBase & "; ReadOnly=True;", _
SQLStatement:="SELECT * FROM [Génération_Code_Barre$]"
'Spécifie la fusion vers un nouveau doc word
.Destination = wdSendToNewDocument
.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
End Sub |
Partager