Word sayfalarını ayrı ayrı dosya olarak açmak

[udentr2002]

Merhaba arkadaşlar.

Benim 400 sayfalık word dosyalarım var. Yapmak istediğim şey, bir buton yardımı ile bo word dosyasını sayfa sayfa ayrı bir word dosyası olarak açmak yani 1. sayfayı sayfa1 adı ile başka bir word dosyası olarak açacak, 2. sayfayı sayfa 2 diye 3. sayfayı sayfa3 diye ayrı ayrı word dosyası olarak bir klasör içine kaydedecek. Böyle bir şeyin imkanı varmı acaba?

 

[udentr2002]

Bunun bir yolu yokmu acaba yada böyle bir şey yapabilmek mümkünmü?

 

[leumruk]

Bunun bir yolu yokmu acaba yada böyle bir şey yapabilmek mümkünmü?

Merhaba,
Aşağıdaki kodu kullanabilirsiniz.

Sub Sayfa_Kaydet()
Dim docC As Document
Dim docN As Document
Dim i As Integer
Dim k As Integer
Selection.HomeKey Unit:=wdStory
Set docC = ActiveDocument
k = ActiveDocument.Content.Information(wdActiveEndPageNumber)
Application.Browser.Target = wdBrowsePage
For i = 1 To k
docC.Bookmarks("\page").Range.Copy
Set docN = Documents.Add
Selection.Paste
Selection.TypeBackspace
docN.SaveAs ThisDocument.Path & "\Sayfa" & i & ".doc"
docN.Close SaveChanges:=wdDoNotSaveChanges
Application.Browser.Next
Next i
MsgBox "Sayfalar başarıyla kaydedildi.", vbInformation, "DURUM"
End Sub

 

[udentr2002]

Hocam çok teşekkürler hemen deniyorum

 

[udentr2002]

Hocam tekrar merhaba,

öncelikle elinize sağlık. Ama şöyle bir isteğim olacak.
O sayfaları kaydederken ana dosyanın formatı ile yani üstbilgi alt bilgiyide kaydetmesi ve sayfa yapısıda ana dosya ile aynı olmalı. Bunun bir imkanı varmı acaba?
Gerçekten olursa beni çok büyük bir yükten kurtaracaksınız. onlarca dosyam var ve her dosya 600 sayfa manuel çok zor böyle bir şey.

 

[leumruk]

Hocam tekrar merhaba,

öncelikle elinize sağlık. Ama şöyle bir isteğim olacak.
O sayfaları kaydederken ana dosyanın formatı ile yani üstbilgi alt bilgiyide kaydetmesi ve sayfa yapısıda ana dosya ile aynı olmalı. Bunun bir imkanı varmı acaba?
Gerçekten olursa beni çok büyük bir yükten kurtaracaksınız. onlarca dosyam var ve her dosya 600 sayfa manuel çok zor böyle bir şey.

Merhaba,
Farklı bir yöntem denedim. Excel üzerinden kayıt işlemini gerçekleştirdim. Dosya ismini ve uzantısını kendi dosyanıza uyarlayın. Eklediğim dosyayı word dosyanızın bulunduğu klasöre kopyalayın ve çalıştırın.

Sub Sayfa_Ayir()
yol = ThisWorkbook.Path
Set wd = CreateObject("word.document")
ChDir "c:\"
    wrd = Application.GetOpenFilename(",*.doc*")
    If wrd = False Then Exit Sub
wd.Application.Documents.Open wrd
Set WDApp = GetObject(, "Word.Application")
Application.ScreenUpdating = False
For x = 1 To WDApp.Selection.Information(wdNumberOfPagesInDocument)
If x > 1 Then
wd.Application.Documents.Open yol & "\" & "Ayir.doc"
Set WDApp = GetObject(, "Word.Application")
End If
For y = WDApp.Selection.Information(wdNumberOfPagesInDocument) To 1 Step -1
WDApp.Selection.Goto What:=wdGoToPage, Which:=wdGoToNext, Name:=y
If y = x Then GoTo Atla
ActiveDocument.Bookmarks("\page").Range.Delete
Atla:
Next
ActiveDocument.SaveAs Filename:=yol & "\Sayfa" & x & ".doc"
ActiveDocument.Close False
Next
MsgBox "Ayırma işlemi tamamlanmıştır.", vbInformation, "l e u m r u k"
End Sub

NOT: Ben 4 sayfalık bir word dosyasında denedim. 600 sayfalık word dosyasında işlem ne kadar sürer bilemiyorum.

 

[udentr2002]

Hocam tekrar elinize sağlık saolun.

Bunu sayfalarını ayıracağımız dosyayı seçebileceğimiz şekilde olabilrmi acaba mesala butona tıkladığımızda dosyayı bilgisayarın kayıtlı olduğu yerden seçsek ve o seçtiğimiz dosyayı sayfalara ayırsa olabilrmi acaba?

 

[leumruk]

Hocam tekrar elinize sağlık saolun.

Bunu sayfalarını ayıracağımız dosyayı seçebileceğimiz şekilde olabilrmi acaba mesala butona tıkladığımızda dosyayı bilgisayarın kayıtlı olduğu yerden seçsek ve o seçtiğimiz dosyayı sayfalara ayırsa olabilrmi acaba?

Merhaba,
Kodu ve dosyayı isteğiniz doğrultusunda güncelledim.