Bonjour,
J'ai un fichier Word de 360 pages (issu d'un publipostage).
Chaque document fait 3 pages. Je veux donc le couper en 120 documents et les renommer 1 par 1.
Pour cela, j'ai inséré des sauts de section après chaque bloc de 3 pages, et construit un fichier excel avec le nom de 120 personnes (colonne A "Nom" : Laurent, Marrion, etc...).
La macro marchait bien au départ.
Mon problème est que lors de la coupure du 1er Word de 3 pages, je souhaite supprimer le saut de section (à la fin de la 3ème page) car sa présence me déclenche l'ajout d'une 4ème page vierge.
J'ai donc ajouté un Control H en VBA pour supprimer ce saut de section en bas de 3ème page, mais cela perturbe mon ordre de saut de section et la macro ne peut pas sélectionner la section suivante. Elle récupère bien le 2nd nom mais revient sur la première section et ne prend pas la suivante.
Je ne vois pas comment faire à part conserver ma 4ème page vierge dans tous mes documents.....
Est ce qu'un de vous sait comment régler ce problème ?
Merci beaucoup pour votre aide
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
60 Sub couper_sections() Application.Browser.Target = wdBrowseSection j = 2 For i = 1 To ((ActiveDocument.Sections.Count) - 1) 'recherche de l'identifiant dans Excel "ordre.xls" Dim xlApp As Object Set xlApp = CreateObject("Excel.Application") xlApp.Visible = True xlApp.Workbooks.Open ("\\xxxxx\Moi\ordre.xls") DocNum = xlApp.ActiveSheet.Cells(j, 1).Value xlApp.activeworkbook.Close True xlApp.Quit Set xlApp = Nothing 'Selectionne et copie le texte de la section dans le presse-papier ActiveDocument.Bookmarks("\Section").Range.Copy 'Crée un nouveau document et colle le texte du presse-papier Documents.Add Selection.Paste ' Retire le saut de section qui a été copié Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "^b" 'saut de section ^b / saut de page ^m .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll 'enregistrement et fermeture du nouveau Word ChangeFileOpenDirectory "\\xxxxx\Moi\Doc\" ActiveDocument.SaveAs FileName:=DocNum & ".doc" ActiveDocument.Close 'section suivante ActiveDocument.Select Application.Browser.Next 'ordre.xls ligne+1 j = j + 1 Next i 'section suivante ActiveDocument.Close savechanges:=wdDoNotSaveChanges End Sub
Partager