Hirdetés

  2. Fórumok
  3. OS, alkalmazások
  4. Microsoft Word topic

Új hozzászólás Aktív témák

  • #1016 Fire/SOUL/CD félisten aleister #1015
    Új Válasz #1016
    Új hozzászólás
    Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra
    Privát üzenet küldése

    Fire/SOUL/CD

    félisten

    válasz aleister #1015 üzenetére

    Hali!

    Neked nem kell semmi VBA programozás tudás hozzá. Lépésenként:

    1. Nyisd meg a dokumentumot, amit fel akarsz darabolni(csak azt!!!)
    2. Üsd le az ALT+F11 billentyű kombinációt, ezzel belépsz a VBA-ba
    3. Hozz létre egy modult, ahogy az alábbi képen látszik

    4. másold ki a forráskódot(lejebb találod majd) és illeszd be ide és futtasd, ahogy az alábbi képen látszik

    5. ha befejezte a munkát(eltart egy ideig, mert direkt úgy írtam, hogy lásd miközben dolgozik, ezért viszont lassabb) és becsukod a VBA editor illetve a wordot akkor NE MENTS SEMMILYEN MÓDOSÍTÁST, HA KÉRDEZI!!!

    6. A makró létrehoz(abba a könyvtárba ahol az eredeti doksi volt) 1.doc, 2.doc, 3.doc...stb fájlokat. AZONBAN: Nem nézem azt, hogy létezik-e ilyen fájl már a könyvtárban, tehát erre figyelj, mert kérdés nélkül felülír minden azonos nevű fájlt!!!(1.doc, 2.doc...stb)

    Itt a forrás:

    Sub Fire_Document_Splitter()
    Dim Pages
    Dim MyRange As Range
    Dim OriginalDoc As Document
    Dim SpilittedDoc As Document
    Set OriginalDoc = ActiveDocument
    Set MyRange = OriginalDoc.Range

    'Application.ScreenUpdating = False
    Pages = OriginalDoc.Content.ComputeStatistics(wdStatisticPages)
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
    For i = 1 To Pages
    If i = Pages Then
    MyRange.End = ActiveDocument.Range.End
    Else
    Selection.GoTo wdGoToPage, wdGoToAbsolute, i + 1
    MyRange.End = Selection.Start
    End If
    MyRange.Copy
    Set SpilittedDoc = Documents.Add
    SpilittedDoc.Range.Paste
    SpilittedDoc.Range.Find.Execute Findtext:="^m", ReplaceWith:=""
    SpilittedDoc.SaveAs FileName:=i & ".doc"
    SpilittedDoc.Close
    MyRange.Collapse wdCollapseEnd
    Next i
    Application.ScreenUpdating = True
    Set OriginalDoc = Nothing
    Set SpilittedDoc = Nothing
    Set MyRange = Nothing
    End Sub

    Fire.

Új hozzászólás Aktív témák