Delitev dokumenta

[Pipi&Melkijad]

Pozdravljeni,
dokument, ki ima 100 strani, bi želel razdeliti na 100 dokumentov. Na vsaki strani je številka dokumenta, ki bi se uporabila za ime novih dokumentov.

Za nasvet, namig, pomoč se zahvaljujem.

[admin]

Spodaj imete pripet makro, ki ga je napisal Graham Skan in vam poljuben dokument razbije po straneh ter vsak poddokument označi s številko strani. To je torej skoraj rešitev vašega problema - razen poimenovanja poddokumentov...

Koda: Izberi vse

Option Explicit 'This goes in the Declarations section of your code module.
 'Hopefully it is already there because you have ticked the 'Require Variable Declaration' _
checkbox. (Tools/Options, Editor tab.)
 
 
Sub SplitIntoPages()
    Dim docMultiple As Document
    Dim docSingle As Document
    Dim rngPage As Range
    Dim iCurrentPage As Integer
    Dim iPageCount As Integer
    Dim strNewFileName As String
     
    Application.ScreenUpdating = False 'Makes the code run faster and reduces screen _
    flicker a bit.
    Set docMultiple = ActiveDocument 'Work on the active document _
    (the one currently containing the Selection)
    Set rngPage = docMultiple.Range 'instantiate the range object
    iCurrentPage = 1
     'get the document's page count
    iPageCount = Selection.Information(wdActiveEndAdjustedPageNumber)
    Do Until iCurrentPage > iPageCount
        If iCurrentPage = iPageCount Then
            rngPage.End = ActiveDocument.Range.End 'last page (there won't be a next page)
        Else
             'Find the beginning of the next page
             'Must use the Selection object. The Range.Goto method will not work on a page
            Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1
             'Set the end of the range to the point between the pages
            rngPage.End = Selection.Start
        End If
        rngPage.Copy 'copy the page into the Windows clipboard
        Set docSingle = Documents.Add 'create a new document
        docSingle.Range.Paste 'paste the clipboard contents to the new document
         'remove any manual page break to prevent a second blank
        docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:=""
         'build a new sequentially-numbered file name based on the original multi-paged file name and path
        strNewFileName = Replace(docMultiple.FullName, ".doc", "_" & Right$("000" & iCurrentPage, 4) & ".doc")
        docSingle.SaveAs strNewFileName 'save the new single-paged document
        iCurrentPage = iCurrentPage + 1 'move to the next page
        docSingle.Close 'close the new document
        rngPage.Collapse wdCollapseEnd 'go to the next page
    Loop 'go to the top of the do loop
    Application.ScreenUpdating = True 'restore the screen updating
     
     'Destroy the objects.
    Set docMultiple = Nothing
    Set docSingle = Nothing
    Set rngPage = Nothing
End Sub

[Pipi&Melkijad]

Pozdravljeni,
poskušam zagnati makro, vendar se nič ne zgodi. Novih dokumentov ne izdela. Kaj je potrebno še narediti?

Hvala za odgovor

[admin]

Pozdravljeni,

zaradi zasluženega ( ) dopusta male zapozneli odgovor...

Kaj natančno se zodi? Ali makro javi napako? Kam ste ga prekopirali in kako zagnali?