Flette til flere filer i Word 2002

Standarden er som du nævner - men herefter kunne Word dokument blive opsplittet en fil pr. sektion. Dette kræver selvfølgelig lidt VBA-kode - men det kan lade sig gøre.

MVH

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

rvm:

Ikke helt forstået..

Jeg opretter makroen - så langt forstår jeg - Hvornår skal den køres? Jeg kan kun få den til at afvikle på første side... Men det er måske også bare det du mener? At man skal kører makroen for hver side?

Den skal køres når du har flettet dokumentet. Så vil det bestå af flere sektioner, der så bliver kopieres over i nye dokumenter via makroen. Hvis du stadig har problemer, så send dit testdokument til mig - så kikker jeg på det :-) rvm(snabela)teknologisk(punktup).dk

rvm:

Ahh... nu kører det - men kan den flette data ind fra den ene kolonne som filnavnet? Fx Kolonne WI

Selvfølgelig, men det er straks et noget mere kompliceret ønske :-) Jeg er straks tilbage med en løsning :)

Cool!! Jeg venter på dig!

'Husk at sætte referancen til Excel i Words makromiljø via Tools/References Microsoft Excel X.X Object Library

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

Dim xlApp As Excel.Application
Dim svar As Boolean

'Opretter Excelobjektet xlApp
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

'Åbner det rigtige regneark
svar = xlApp.Dialogs(xlDialogOpen).Show

'Hvis der er valgt et regneark
If svar = True Then
   
    'Nummeret på den kolonne i Excel, hvor navnet står - I DETTE TILFØLDE KOLONNE A
    Kolonne = 1
   
    'Navnet på moder dokumentet
    Navn = ActiveDocument.Name
   
    'Denne kode gennemløber alle sektioner i moderdokumentet
    For række = 1 To Documents(Navn).Sections.Count
        Documents(Navn).Sections(række).Range.Select
        Selection.Copy
        Documents.Add DocumentType:=wdNewBlankDocument
        Selection.Paste
        ActiveDocument.SaveAs xlApp.Cells(række, Kolonne).Value & ".doc"
        ActiveDocument.Close
    Next
End If

xlApp.Quit
Set xlApp = Nothing

End Sub

Hold da op - Du er genial! - Det virker upåklageligt! - Tak

:-)

Mon du stadig er der - Jeg har et problem - Den laver to sider, selvom dokumentet kun er er en side. Kan man tvinge den til kun at tage første side?

Prøv denne :-)

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

Dim xlApp As Excel.Application
Dim svar As Boolean

'Opretter Excelobjektet xlApp
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

'Åbner det rigtige regneark
svar = xlApp.Dialogs(xlDialogOpen).Show

'Hvis der er valgt et regneark
If svar = True Then
   
    'Nummeret på den kolonne i Excel, hvor navnet står - I DETTE TILFØLDE KOLONNE A
    Kolonne = 1
   
    'Navnet på moder dokumentet
    Navn = ActiveDocument.Name
   
    'Denne kode gennemløber alle sektioner i moderdokumentet
    For række = 1 To Documents(Navn).Sections.Count
        Documents(Navn).Sections(række).Range.Select
        Selection.Copy
        Documents.Add DocumentType:=wdNewBlankDocument
        Selection.Paste
       
        'Sletter den ekstra sektion som kopiering medfører
        Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
        Selection.Delete Unit:=wdCharacter, Count:=1

        ActiveDocument.SaveAs xlApp.Cells(række, Kolonne).Value & ".doc"
        ActiveDocument.Close
    Next
End If

xlApp.Quit
Set xlApp = Nothing

End Sub

Ihhh... altså ... den gemmer ikke formateringen - Nu gider jeg snart ikke mere!! - Mit dokument er "liggende" - Men når jeg bruger din makro bliver det nye dokument stående...

Det kan vi da også gøre noget ved :-)

Hvilke formateringer som du har ændret kommer ikke med?

Du behøver ikke at skrive hvad de er ændret til, bare at de er ændret

Her er f.eks. en kode der sætter de nye dokumenter til samme papirretning som det gamle:

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

Dim xlApp As Excel.Application
Dim svar As Boolean
Dim Antal As Integer

'Opretter Excelobjektet xlApp
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

'Åbner det rigtige regneark
svar = xlApp.Dialogs(xlDialogOpen).Show

'Hvis der er valgt et regneark
If svar = True Then
   
    'Nummeret på den kolonne i Excel, hvor navnet står
    Kolonne = 1
   
    'Navnet på moder dokumentet
    Navn = ActiveDocument.Name
   
    'Denne kode gennemløber alle sektioner i moderdokumentet
    For række = 1 To Documents(Navn).Sections.Count
        Documents(Navn).Sections(række).Range.Select
        Selection.Copy
        Documents.Add DocumentType:=wdNewBlankDocument

        Selection.Paste

        Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
        Selection.Delete Unit:=wdCharacter, Count:=1
       
        ActiveDocument.PageSetup.Orientation = Documents(Navn).PageSetup.Orientation
       
        ActiveDocument.SaveAs xlApp.Cells(række, Kolonne).Value & ".doc"
        ActiveDocument.Close
    Next
End If

xlApp.Quit
Set xlApp = Nothing

End Sub

Perfekt - Nu kører det!

:-)

Grrrr.... du kan vel ikke... hjælpe med at få margin til at blive som i masteren også?

Kan man ikke lave noget PageSetup.margin? eller noget i den stil... please

et øjeblik :-)

Jeg tror sgu jeg selv løste det!!! Sorry!

Synes faktisk du skal ha' lidt flere point... må man det - og hvordan?

Efter denne linie
ActiveDocument.PageSetup.Orientation = Documents(Navn).PageSetup.Orientation

indsættes diee 4 linier
ActiveDocument.PageSetup.TopMargin = Documents(Navn).PageSetup.TopMargin
ActiveDocument.PageSetup.BottomMargin = Documents(Navn).PageSetup.BottomMargin
ActiveDocument.PageSetup.LeftMargin = Documents(Navn).PageSetup.LeftMargin
ActiveDocument.PageSetup.RightMargin = Documents(Navn).PageSetup.RightMargin

Jeg behøver ikke flere point :-)

Okey - Det må du selv om - Tusind tak for hjælpen!!!

Jeg er ved at blive skør! - Der sker desværre en fejl:

Jeg har jo navngivet kolonerne A1: ID B1:Navn C3: Dato

Så når jeg kører makroen sker der det, at den tager A1, B2 og C2

Forstår du - Det vil sige at den fletter skævt...

Nej C3 = C1: Dato

det forstår jeg ikke - prøv atr sende dine filer til mig, så tjekker jeg det lige ... rvm(snabela)teknologisk(punktum).dk

Tak - jeg orker ikke at bruge mere tid på dette - Jeg laver to data filer - Så virker det!

Endnu engang tak for al din hjælp!!

Pop