Menu

Macro publipostage couper un fichier en plusieurs fichiers

Messages postés
2
Date d'inscription
jeudi 10 janvier 2019
Dernière intervention
11 janvier 2019
- - Dernière réponse : Xnd99
Messages postés
2
Date d'inscription
jeudi 10 janvier 2019
Dernière intervention
11 janvier 2019
- 11 janv. 2019 à 15:46
Bonjour à tous,

A partir d'un publipostage (400 entrées qui génèrent un fichier de 6 à 8 pages), je souhaite créer autant de fichiers que d'entrées et les renommer par la même occasion.

J'ai trouvé deux macros qui répondent assez bien à ma demande, mon seul problème est que les X fichiers générés sont identiques. En effet, le publipostage reste dans les documents, ce qui veut dire que chaque fichier permet de consulter l'ensemble des entrées.

Désolé si je ne suis pas très clair. J'aimerai que les fichiers générés ne soit plus rattaché au fichier Excel servant de base.

Sub Macro1()
'
' Macro1 Macro
''
'définit "nom" en fonction de la valeur du champ de la 2ème colonne du tableau excel
nom = ActiveDocument.MailMerge.DataSource.DataFields(2).Value
'idem pour "prénom" en fonction de la valeur de la colonne n°3
prénom = ActiveDocument.MailMerge.DataSource.DataFields(3).Value
'idem pour "prénom" en fonction de la valeur de la colonne n°6
consultation_du = ActiveDocument.MailMerge.DataSource.DataFields(6).Value

ChangeFileOpenDirectory "U:\TEST"
ActiveDocument.SaveAs FileName:=nom & " 2018.docx", FileFormat:=wdFormatXMLDocument

ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord

End Sub
Sub Lancer_plusieurs_fois()
'
' Lancer_plusieurs_fois Macro
''
Dim Compteur As Long
For Compteur = 1 To 40
Macro1
Next Compteur

ActiveDocument.Close savechanges:=wdDoNotSaveChanges

End Sub


Merci d'avance.
Afficher la suite 

Votre réponse

2 réponses

Messages postés
14836
Date d'inscription
mardi 12 juin 2007
Statut
Contributeur
Dernière intervention
12 janvier 2019
11294
0
Merci
Bonjour

Il faut d'abord faire la fusion pour obtenir un fichier sans liens et ensuite lancer une macro que j'ai ici par exemple :
http://faqword.com/index.php/word/divers/552-comment-couper-un-gros-fichier-en-autant-de-petits-fichiers-quil-y-a-de-sauts-de-section

Maintenant, pour 400 fichiers, ça va prendre un certain temps. Tu pourras aller prendre un café ! :)

m@rina
Commenter la réponse de m@rina
Messages postés
2
Date d'inscription
jeudi 10 janvier 2019
Dernière intervention
11 janvier 2019
0
Merci
Bonjour M@rina,

Merci pour ton aide. J'avais testé quelque chose de similaire (je crois) mais cela posait problème à cause des différents sauts de section présents dans le modèle.

On m'a aidé à modifier la macro qui maintenant fonctionne bien. Je voudrais juste encore réussir à enregistrer les documents générés dans des sous-dossiers selon la colonne 3 de mon tableau Excel (secteur).

Sub Macro5()
'
' Macro1 Macro
'
x = ActiveDocument.MailMerge.DataSource.RecordCount
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord

For i = 1 To x


'définit "nom" en fonction de la valeur du champ de la 2ème colonne du tableau excel
nom = ActiveDocument.MailMerge.DataSource.DataFields(2).Value
'idem pour "prénom" en fonction de la valeur de la colonne n°6
secteur = ActiveDocument.MailMerge.DataSource.DataFields(3).Value
'consultation_du = ActiveDocument.MailMerge.DataSource.DataFields(6).Value


With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = i
.LastRecord = i
End With
.Execute Pause:=False
End With

ChangeFileOpenDirectory "C:\PROJET\" '& secteur & " \ """
ActiveDocument.SaveAs2 FileName:=nom & " EA 2018.docx", FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False, CompatibilityMode:=15
ActiveWindow.Close

ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord

Next i
End Sub


Si jamais tu as une idée... merci !
Commenter la réponse de Xnd99