eclater un doc en plisuers fichiers suite publipostage

[macflash]

Bonjour à tous,

J'ai besoin d'éclater un document constitué par publipostage, en créant autant de .doc que de sections
du doc principal. Pour cela, j'ai utilisé la macro suivante que m'a passé un collegue :
cela marche bien, mais au lieu de numéroter séquentiellement les différents fichiers doc résultants
(voir instruction .... "prefixe & DocNum & ".doc" ), je voudrais remplacer le DocNum par le contenu
d'un champ de fusion (ex : nom) pour avoir cela à peu près :

fiche_dupont.doc
fiche_durant.doc
etc...

et non :

fiche_1.doc
fiche_2.doc
etc...

(jai essayé d'encadrer le champ de fusion par deux signets dans mon modèle... pas de chance,
les signets ne sont pas passés dans le doc fusionné)
(j'ai essayé aussi d'attribuer un style spécifique au champ de fusion dans mon modèle... meme punition)

Si quelqu'un a une idée, elle sera bien venue

Code de la macro :

Sub creat_fiche()
'
   'code ouverture boite dialogue repertoire
    Const WINDOW_HANDLE = 0
    Const NO_OPTIONS = 0
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "Choisir un répertoire:", NO_OPTIONS, "C:\")

    If InStr(1, TypeName(objFolder), "Folder") > 0 Then
        Set objFolderItem = objFolder.Self
        objPath = objFolderItem.Path
        
        'Demande à l'utilisateur d'entrer le préfixe des fichiers à créer
        prefixe = InputBox("Entrez le préfixe du nom des fichiers :", "Préfixe du nom de fichier", "")
        If prefixe <> "" Then
            'cas où l'utilisateur a spécifié un repertoire et un préfixe pour ses fichiers
            
            Application.Browser.Target = wdBrowseSection

            For i = 1 To ((ActiveDocument.Sections.Count) - 1)
  

                ActiveDocument.Bookmarks("\Section").Range.Copy
 
                Documents.Add
                Selection.Paste

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

                ChangeFileOpenDirectory objPath
                DocNum = DocNum + 1
                ActiveDocument.SaveAs FileName:=prefixe & DocNum & ".doc"
                ActiveDocument.Close
                
                Application.Browser.Next
                
            Next i
            
            ActiveDocument.Close savechanges:=wdDoNotSaveChanges
        
            MsgBox "Terminé"
        
        Else
            MsgBox "Traitement Annulé"
        End If
           
    
    
    Else
        MsgBox "Traitement Annulé"
    End If
    
   
End Sub

 

[KangOl]

balise

 :o

 

[macflash]

oups.. désolé, comme d'habitude, je n'ai pas lu le mde d'emploi ...

 

[KangOl]

merci