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

• #1016 Fire/SOUL/CD félisten aleister #1015

  Új Válasz 2009-03-02 15:00:19 #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