Meerdere paginas verschillend op slaan in word 2010

Status
Niet open voor verdere reacties.
De Splitter macro werkt op basis van Pagina's; elke pagina wordt daarmee in een apart document gezet. Als je recepten hebt die meerdere pagina's beslaan heb je aan die techniek weinig. Je kunt dan beter splitsen op basis van secties. Je voegt dan na elk recept een Sectie-einde in, en met een andere macro maak je dan van alle secties een apart document.
De macro van Doug Robbins doet het verder prima, als je alle variabelen declareert, wat in de voorbeeldmacro niet het geval is. En dan werkt de macro niet als je de optie Option Explicit in je module gebruikt. Zo is hij af:
Code:
Sub SplitPage()
' splitter Macro
' Macro created 16-08-98 by Doug Robbins to save each page of a document as a separate file with the name Page#.DOC
'
Dim Counter As Long, Pages As Integer
Dim Source As Document, Target As Document
Dim DocName As String

    Set Source = ActiveDocument
    Selection.HomeKey Unit:=wdStory
    Pages = Source.BuiltInDocumentProperties(wdPropertyPages)
    Counter = 0
    While Counter < Pages
        Counter = Counter + 1
        DocName = "Page" & Format(Counter)
        Source.Bookmarks("\Page").Range.Cut
        Set Target = Documents.Add
        Target.Range.Paste
        Target.SaveAs FileName:=DocName
        Target.Close
    Wend
End Sub
En als je met secties werkt:
Code:
Sub Splitter()
'------------------------------------------------------------------------------------------------------------------
' splitter Macro
' Macro created by Doug Robbins to save each letter created by a mailmerge as a separate file.
' Adapted by OctaFish to extend Filename with 1st paragraph
'------------------------------------------------------------------------------------------------------------------
Dim Letters As Integer, Counter As Integer
Dim DocName As String, sRange As String
Dim Pad As String, sNullen As String
Dim aRange As Range
Dim aDoc As Document, aDocNew As Document

    DocName = "Recept "
    Pad = "H:\Temp\Word\"
    
    Set aDoc = ActiveDocument
    Letters = aDoc.Sections.Count
    For Counter = 1 To Len(Letters)
        sNullen = sNullen & "0"
    Next Counter
    sNullen = sNullen & "0"
    
    Selection.HomeKey Unit:=wdStory
    Counter = 1
    While Counter < Letters
        '-----------------------------------------------------------------------------
        'Naam samenstellen op basis van nummering
        '-----------------------------------------------------------------------------
        DocName = Right(sNullen & LTrim$(Str$(Counter)), Len(Letters) + 1) & "_"
        '-----------------------------------------------------------------------------
        aDoc.Sections.First.Range.Cut
        Set aDocNew = Documents.Add
        Selection.Paste
        '-----------------------------------------------------------------------------
        'Naam samenstellen uit 1e alinea van tekst
        '-----------------------------------------------------------------------------
        With aDocNew
            Set aRange = .Paragraphs(1).Range
            DocName = DocName & aRange.Text
            If Right(DocName, 1) = Chr(13) Or Right(DocName, 1) = Chr(10) Then
                DocName = Left(DocName, Len(DocName) - 1)
            End If
            '-----------------------------------------------------------------------------
            .Sections(2).PageSetup.SectionStart = wdSectionContinuous
            .SaveAs _
                FileName:=Pad & DocName & ".doc", _
                FileFormat:=wdFormatDocument, _
                AddToRecentFiles:=False
        End With
        ActiveWindow.Close
        Counter = Counter + 1
    Wend

End Sub
Deze versie is wat uitgebreider; hij gebruikt de eerste regel (meestal een kopje of titel) als bestandsnaam.
Macro's zet je in een module. Van daaruit kun je er een sneltoets aanhangen, of ze vanuit de module opstarten.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan