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
59
| Sub Publiposttotrap()
' Déclaration des variables
Dim iR As Integer
Dim i As Integer
Dim oDoc As Document: Dim numcaisses As Variant: Dim nomcaisse As Variant
Dim DocName As String
Dim oDS As MailMergeDataSource
' Affectation des objets
Set oDoc = ActiveDocument
Set oDS = oDoc.MailMerge.DataSource
Dim Rep As Integer ' boite d'alerte vous allez ecraser tous les fichiers
Rep = MsgBox("Voulez-vous continuez ? vous allez écraser les précédents documents", vbYesNo + vbQuestion, "mDF XLpages.com")
If Rep = vbYes Then
iR = oDoc.MailMerge.DataSource.RecordCount
Debug.Print iR
For i = 1 To iR
With oDoc.MailMerge
'Définition du premier et dernier enregistrement
.DataSource.FirstRecord = i
.DataSource.LastRecord = i
' Envoi des données dans un nouveau document
'.Destination = wdSendToNewDocument
' Exécution du publipostage
.Execute
' Actualisation de l'enregistrement pour la sauvegarde
.DataSource.ActiveRecord = i
'Utilisation d'un champs pour obtenir le nom du document, 2 champs pour le chemin
DocName = .DataSource.DataFields(1).Value
numcaisse = .DataSource.DataFields(1).Value
nomcaisse = .DataSource.DataFields(2).Value
dossier = "D:\cbi 2019\" & numcaisse & " " & nomcaisse & "\00 Rapports"
Debug.Print DocName; i
End With
' Sauvegarde du document publiposté
ChangeFileOpenDirectory "D:\cbi 2019\" & numcaisse & " " & nomcaisse & "\00 Rapports\"
With ActiveDocument
.SaveAs FileName:= _
numcaisse & " Certification des Comptes 2018.doc", FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
.Close
End With
Next i
Else
End
End If
End Sub |
