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 56 57 58
|
Sub TestPDF()
'Déclaration variables
Dim IR As Integer, I As Integer
Dim DocName As String, RepertoireDestination As String
Dim oDoc As Document
Dim oDS As MailMergeDataSource
RepertoireDestination = "C:\Users\MONID\BOITE\SERVICE (Grp. O365) - Documents\Télétravail\Avenants pour envoi\"
'Affectation des objets
Set oDoc = ActiveDocument
Set oDS = oDoc.MailMerge.DataSource
IR = oDoc.MailMerge.DataSource.RecordCount
' Debug.Print IR
For I = 1 To IR
With oDoc.MailMerge
'Premier & dernier enregistrement
.DataSource.FirstRecord = I
.DataSource.LastRecord = I
'Envoi dans un nouveau doc
.Destination = wdSendToNewDocument
.Execute
'Actualisation de l'enregistrement pour la sauvegarde
With .DataSource
.ActiveRecord = I
DocName = .DataFields(7) & .DataFields(8) & "Avenant télétravail"
Debug.Print DocName; I
End With
With ActiveDocument
.ExportAsFixedFormat OutputFileName:= _
RepertoireDestination & DocName & ".pdf", ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
wdExportAllDocument, From:=1, To:=1, Item:=wdExportDocumentContent, _
IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:= _
wdExportCreateNoBookmarks, DocStructureTags:=True, BitmapMissingFonts:= _
True, UseISO19005_1:=False
.Close savechanges:=wdDoNotSaveChanges
End With
End With
Next I
Set oDoc = Nothing
Set oDS = Nothing
End Sub |
Partager