[WD-2007] Macro BreakOnSection perte de mise en forme [Résolu]

[lefenek]

Bonjour a tous,

J'ai utilisé la macro BreakOnSection afin de couper un publipostage.
Ça fonctionne, j'ai bien un fichier Word de créé par section. En revanche j'ai perdu styles, polices et mise en page. Voici ce que j'exécute:

Code :

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
Sub BreakOnSection()
   ' Used to set criteria for moving through the document by section.
   Application.Browser.Target = wdBrowseSection
 
   'A mail merge document ends with a section break next page.
   'Subtracting one from the section count stop error message.
   For i = 1 To ((ActiveDocument.Sections.Count) - 1)
 
'Note: If a document does not end with a section break, 
'substitute the following line of code for the one above:
'For I = 1 To ActiveDocument.Sections.Count
 
      'Select and copy the section text to the clipboard.
      ActiveDocument.Bookmarks("\Section").Range.Copy
 
      'Create a new document to paste text from clipboard.
      Documents.Add
      Selection.Paste
 
   ' Removes the break that is copied at the end of the section, if any.
      Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
      Selection.Delete Unit:=wdCharacter, Count:=1
ChangeFileOpenDirectory "C:\"
      DocNum = DocNum + 1
     ActiveDocument.SaveAs FileName:="test_" & DocNum & ".doc"
     ActiveDocument.Close
      ' Move the selection to the next section in the document.
     Application.Browser.Next
   Next i
   ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub

Je n'ai aucune notion de Vba, comment garder styles, polices et mise en page sur les nouveaux fichier words créés?

En espérant un peu d'aide.
Merci de m'avoir lu

[carden752]

bonjour,

vous poucez utiliser plutot

Code :

selection.pasteandformat (wdFormatOriginalFormatting)

au lieu de selection.paste
Cela conserve la mise en forme d'origine.

[lefenek]

Merci beaucoup Monsieur

[lefenek]

Merci encore a carden752 pour la réponse. La macro fonctionne correctement j'ai bien la mise en page qui est gardée et tout et tout.

En revanche, pour chaque fichier créé par section il me rajoute une page blanche à la fin. Je ne trouve pas ça gênant mais tout le monde n'est pas de mon avis.

Voila ce que je lance:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub Fédé()
   ' Used to set criteria for moving through the document by section.
   Application.Browser.Target = wdBrowseSection
 
   'A mailmerge document ends with a section break next page.
   'Subtracting one from the section count stop error message.
   For i = 1 To ((ActiveDocument.Sections.Count) - 1)
 
      'Select and copy the section text to the clipboard
      ActiveDocument.Bookmarks("\Section").Range.Copy
 
      'Create a new document to paste text from clipboard.
      Documents.Add
      Selection.PasteAndFormat (wdFormatOriginalFormatting)
 
     ChangeFileOpenDirectory "C:\"
      DocNum = DocNum + 1
     ActiveDocument.SaveAs FileName:="Doc_" & DocNum & ".doc"
     ActiveDocument.Close
      ' Move the selection to the next section in the document
     Application.Browser.Next
   Next i
   ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub

Une idée pour supprimer cette page blanche en fin de chaque fichier?

Merci

[Sepia]

Salut Lefenek,

Dans la 1ere macro, tu supprimais le dernier caractère ajouté (lignes après le Selection.Paste). Carden752 te proposait juste de remplacer le Selection.Paste mais je pense que tu devrais garder le reste (c'est-à-dire le code qui supprime ).

@+

[lefenek]

Merci pour ta réponse Sepia

Quand je rajoute :

Code :

1
2
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
      Selection.Delete Unit:=wdCharacter, Count:=1

J'ai plus de page blanche supplementaire mais plus de mise en page également.

j'ai créé une nouvelle discusion vu que celle ci était en résolu.