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 47 48 49 50 51 52 53 54 55
| Option Explicit
Sub Publipostage_Macro()
Dim i As Integer, DataPubli As Variant, maxi As Integer
Dim fichier_excel As String, fichier_doc_original As String, chemin As String
Dim save_date As String, save_name As String
DataPubli = Worksheets("DataPubli").Range("A2:Z100")
fichier_doc_original = "publipostage.doc"
fichier_excel = ActiveWorkbook.Name
Onglet_data_publi = "DataPubli" 'Nom de l'onglet où sont les données
'Ouverture fichier word
Dim appWrd As Word.Application
Dim docWord As Word.Document
Set appWrd = CreateObject("Word.Application")
chemin = ThisWorkbook.Path 'répertoire
Set docWord = appWrd.Documents.Open(chemin & "\" & fichier_doc_original) 'ouverture .doc original
appWrd.Visible = True
'Compte les lignes de données
For i = 1 To 100
If DataPubli(i, 1) <> "" Then maxi = i
Next
'Publipostage Word
With docWord.MailMerge
.OpenDataSource Name:=ThisWorkbook.FullName, _
ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
Revert:=False, Format:=wdOpenFormatAuto, _
SQLStatement:="SELECT * FROM `" & "DataPubli" & "$`", SubType:=wdMergeSubTypeAccess
.Destination = wdSendToNewDocument
With .DataSource
.FirstRecord = 1
.LastRecord = maxi 'nombre de pages à créer
End With
.Execute Pause:=False
End With
'Fermeture .doc original
docWord.Close SaveChanges:=wdDoNotSaveChanges
Set docWord = Nothing
'Enregistrement .doc créé (facultatif)
appWrd.ChangeFileOpenDirectory chemin ' & "\"
save_date = Format(Date, "yy") & "." & Format(Date, "mm") & "." & Format(Date, "dd") 'Format à personnaliser
save_name = save_date & "." & SiteLieu & ".doc" 'Format à personnaliser
appWrd.ActiveDocument.SaveAs Filename:=save_name
'Fermeture .doc créé (facultatif)
appWrd.Quit
Set appWrd = Nothing
End Sub |
Partager