Brevfletning til selvstændige dokumenter

Kør denne kode efter du har brevflettet:

Sub GemHverSektionForSigSelv()

'Denne makro gemmer hver sektion i et dokument i hvert sit dokument
    Svar = InputBox("Indtast filnavn", "Filnavn")
    Navn = ActiveDocument.Name
   
    NrSec = ActiveDocument.Sections.Count
    For i = 1 To NrSec
        ActiveDocument.Sections(i).Range.Select
        Selection.Copy
        Documents.Add DocumentType:=wdNewBlankDocument
        Selection.Paste
        ActiveDocument.SaveAs Svar & i
        ActiveDocument.Close
    Next
End Sub

Fantastisk.  Du får 30 point ekstra hvis koden kan tilpasses således at filnavnet kan genereres ud fra fra oplysningen i et af flettefelterne.

Desværre forsvinder flettefelterne, når der brevlflettes, så den er straks lidt værre..

Prøv denne:

Sæt i dit masterdokument tegnet "#" foran og bagved det felt, der indeholder navnet på filen. Skjul så tegnene via Formater/Skrifttype Skjult

Sub GemHverSektionForSigSelv()
'Denne makro gemmer hver sektion i et dokument i hvert sit dokument

    Navn = ActiveDocument.Name
   
    NrSec = ActiveDocument.Sections.Count
    For i = 1 To NrSec
        ActiveDocument.Sections(i).Range.Select
        Selection.Copy
        Documents.Add DocumentType:=wdNewBlankDocument
        Selection.Paste
       
        'Gå til toppen af dokumentet
        Selection.HomeKey Unit:=wdStory
       
        Selection.Find.ClearFormatting
        Selection.Find.Text = "#"
        Selection.Find.Execute
       
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="Nr1"
   
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = "#"
            .Forward = True
        End With
       
        Selection.Find.Execute
        ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="Nr2"
   
        Dim doc As Document
        Dim rngDoc As Range
   
        Set doc = ActiveDocument
         
        Set rngDoc = doc.Range(Start:=doc.Bookmarks("Nr1").Range.Start, _
        End:=doc.Bookmarks("Nr2").Range.Start)
       
        rngDoc.Select
   
        svar = rngDoc
       
        ActiveDocument.SaveAs svar & i
        ActiveDocument.Close
    Next
End Sub