- hdanesz: Hyundai Ioniq 28kWh - Első benyomások - második felvonás
- Elektromos rásegítésű kerékpárok
- Viber: ingyen telefonálás a mobilodon
- sziku69: Fűzzük össze a szavakat :)
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Gurulunk, WAZE?!
- Luck Dragon: Asszociációs játék. :)
- btz: Internet fejlesztés országosan!
- vrob: Az IBM PC és a játékok a 80-as években
- bambano: Bambanő háza tája
Új hozzászólás Aktív témák
-
válasz
aleister #1019 üzenetére
Hali!
Szivesen!
Annyit még azért hozzátennék(elfelejtettem írni), hogy azért van egy kis "hibája" a proginak.
Ha egy oldal végén nem oldaltörés van, hanem csak úgy átcsúszik a következő oldalra, akkor egy plusz üres lapot berak pluszba a mentett fájlba...
De ez csak egy kis szépséghiba... könnyen orvosolhatóFire.
-
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átszik4. 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 SubFire.
-
Új hozzászólás Aktív témák
Hirdetés
- BESZÁMÍTÁS! ASUS H610M I5 12400F 32GB DDR5 512GB SSD X 4060 8GB SPIRIT OF GAMER CLONE 3 Chieftec600W
- ÁRGARANCIA!Épített KomPhone i5 14600KF 32/64GB RAM RTX 5060 Ti 16GB GAMER PC termékbeszámítással
- AKCIÓ! ASUS MAXIMUS VIII HERO Z170 chipset alaplap garanciával hibátlan működéssel
- Honor 400 lite 256GB, Kártyafüggetlen, 1 Év Garanciával
- MacBook felvásárlás!! MacBook, MacBook Air, MacBook Pro
Állásajánlatok
Cég: PC Trade Systems Kft.
Város: Szeged
Cég: Promenade Publishing House Kft.
Város: Budapest