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