• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

word'de sayfaları ayrı dosya olarak kaydetmek?

A

abcd_efe

Katılım
13 Ocak 2005
Mesajlar
212
merhaba arkadaşlar. 30 sayfalık tek bir word dosyasının her bir sayfasını ayrı word dosyaları olarak nasıl kaydedebilirim yardımcı olursanız sevinirim. şimdiden teşekkür ederim. iyi çalışmalar. (sitede aşağıdaki kodları buldum macro olarak ekledim ama çalıştıramadım veya çalışmıyor)



Sub Sayfayi_Ayir_Kaydet()

' alttaki satıra tırnak içine yeni sayfaların kaydedileceği klasör yolu yazılacak...

Const strPath = "D:\Yeniklasor"
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(wdActiveEndPage Number)
' ayırıcı kriter=sayfa
Application.Browser.Target = wdBrowsePage

' alttaki satırda kaçıncı sayfadan kaçıncı sayfaya kadar kaydedileceğini belirtiyoruz...
' burada 1.den sona kadardır. Mesela 5 ila 10. sayfaları istersen For i = 5 To 10 şeklinde
' değiştir...

For i = 1 To k

docC.Bookmarks("\page").Range.Copy
Set docN = Documents.Add
Selection.Paste
Selection.TypeBackspace
docN.SaveAs FileName:="Sayfa" & i & ".docx", FileFormat:=wdFormatDocument, _
AddToRecentFiles:=False
docN.Close SaveChanges:=wdDoNotSaveChanges
' Move the selection to the next page in the document.
Application.Browser.Next
Next i
docC.Close SaveChanges:=wdDoNotSaveChanges
End Sub
 
aşagıdaki kod istediginiz işlemi tam anlamıyla excelde yapıyor.Fakat word egöre uyarlıyamadım.Umarım sayın uzmanlarımız bu kodu worlde göre uyarlıyabilirler.
Kod: 
Sub kaydet()
Dim evn As Object, i As Byte, x As Byte, Klasor As String, Yol As String
i = Worksheets.Count
Yol = ThisWorkbook.Path
Klasor = Mid(ThisWorkbook.Name, 1, Len(ThisWorkbook.Name) - 4)
Set evn = CreateObject("Scripting.FileSystemObject")
        If Not EVN.FolderExists(Yol & "\" & Klasor) Then
            EVN.CreateFolder (Yol & "\" & Klasor)
        End If
For x = 1 To i
    Workbooks(Klasor & ".xls").Sheets(x).Copy
        ActiveWorkbook.SaveAs Filename:=Yol & "\" & Klasor & "\" _
                    & Workbooks(Klasor & ".xls").Sheets(x).Name
        ActiveWorkbook.Close
Next x
set evn = nothing:i=empty:x=empty
klasor=vbnullstring:yol=vbnullstring
End Sub
 
Merhaba,
Örnek dosyayı rardan çıkarıp deneyiniz. Dosya hangi klasördeyse sayfaları orada oluşturur. Makronun çalışması için word dosyanızın makro güvenlik seviyesinin düşük olması gerekli. Güvenlik seviyesini düşürmek için:
ARAÇLAR>MAKRO>GÜVENLİK>DÜŞÜK seviyesini seçip dosyanızı kapatıp açınız.
Makroyu kendi word dosyanızda çalıştırmak için Araçlar>Makro>Makrolar kısmından makroyu seçip çalıştır butonuna tıklamanız yeterli. Tabi öncesinde eklediğim makroyu word dosyanızın Thisdocument kısmına kopyalamalısınız.
Ekte 5 sayfalık bir örnek ekledim. Kodlar içinde...
Kod: 
Sub Makro1()
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
 
leumruk' Alıntı:
Merhaba,
Şu haliyle sayfa numarasına göre kaydediyor. Siz farklı bir şey mi istiyorsunuz?
Genişletmek için tıkla ...

Merhaba,

Exceldeki hücrelerden isimleri alarak kaydedebilir mi.

Şu haliyle sayfa1 yazıp kaydediyor. Bunun yerine herhangi bir exceldeki 1.hücrenin içindeki veriyi alıp kaydedebilir mi?
 
Bu kod satırını:
Kod: 
docN.SaveAs ThisDocument.Path & "\Sayfa" & i & ".doc"
Bununla değiştirin:
Kod: 
docN.SaveAs ThisDocument.Path & "\" & cells(i,1) & ".doc"

İsimleri excelin 1. sütununa eklemiş olun, yoksa hata alırsınız. Daha kesin bir cevap için örnek dosya ile ne istediğinizi belirtin.
 
leumruk' Alıntı:
Merhaba,
Örnek dosyayı rardan çıkarıp deneyiniz. Dosya hangi klasördeyse sayfaları orada oluşturur. Makronun çalışması için word dosyanızın makro güvenlik seviyesinin düşük olması gerekli. Güvenlik seviyesini düşürmek için:
ARAÇLAR>MAKRO>GÜVENLİK>DÜŞÜK seviyesini seçip dosyanızı kapatıp açınız.
Makroyu kendi word dosyanızda çalıştırmak için Araçlar>Makro>Makrolar kısmından makroyu seçip çalıştır butonuna tıklamanız yeterli. Tabi öncesinde eklediğim makroyu word dosyanızın Thisdocument kısmına kopyalamalısınız.
Ekte 5 sayfalık bir örnek ekledim. Kodlar içinde...
Kod: 
Sub Makro1()
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
Genişletmek için tıkla ...

merhaba gösterdiğiniz gibi word içerisinde macro'yu çalıştırdım lakin oluşturduğu sayfalar düzensiz (içerisine boşluklar ekleyip metni alt sayfalara kaydırdı) nacizane bir isteğim içerik bozulmadan "rtf" formatında kayıt yapması ve dosya ismini oluşturduğumuz yeni dosya içerisinden belirleyeceğimiz bir veya iki alandan alması.
şimdiden teşekkür ederim.
 
Merhabalar,
Sayfa numarası ile değil de Word içerisindeki belirlediğimiz bir alandan sayfaları isimlendirmek mümkün mü? Excel'den isimlendirmeyi başaramadım.
Teşekkürler.
 
Merhaba,
İstediğiniz mümkün ama çözüm üretebilmek için örnek dosyanızın olması ve gerekli açıklamaların yapılmış olması gerekiyor.
 
İyi Akşamlar;

emeğiniz için teşekkürler.

Bu makroyu, mektup birleştirme fonksiyonunda da kullanmamız mümkün mü,
Mektup birleştirme fonksiyonunda, mektupları birleştirdikten sonra sayfaları bu makro ile ayrı ayrı kayıt yaparken verileri aldığımız excelde bulunan liste sayfasının B sutrundaki numaralar ile kayıt yapmamız mümkün müdür?
 
leumruk' Alıntı:
Merhaba,
Örnek dosyayı rardan çıkarıp deneyiniz. Dosya hangi klasördeyse sayfaları orada oluşturur. Makronun çalışması için word dosyanızın makro güvenlik seviyesinin düşük olması gerekli. Güvenlik seviyesini düşürmek için:
ARAÇLAR>MAKRO>GÜVENLİK>DÜŞÜK seviyesini seçip dosyanızı kapatıp açınız.
Makroyu kendi word dosyanızda çalıştırmak için Araçlar>Makro>Makrolar kısmından makroyu seçip çalıştır butonuna tıklamanız yeterli. Tabi öncesinde eklediğim makroyu word dosyanızın Thisdocument kısmına kopyalamalısınız.
Ekte 5 sayfalık bir örnek ekledim. Kodlar içinde...
Kod: 
Sub Makro1()
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
Genişletmek için tıkla ...
Merhaba bunu her sayfayı farklı olarak değil de beşer beşer kaydetmem lazım acaba bir yolu var mı?
Yani 1-5 sayfalar 1. dosya , 5-10 sayfalar 2. dosya
bu konuda yardımcı olabilir misiniz?
döngüyü kuramadım malesef.
 
sadoo123' Alıntı:
Merhaba bunu her sayfayı farklı olarak değil de beşer beşer kaydetmem lazım acaba bir yolu var mı?
Yani 1-5 sayfalar 1. dosya , 5-10 sayfalar 2. dosya
bu konuda yardımcı olabilir misiniz?
döngüyü kuramadım malesef.
Genişletmek için tıkla ...
Merhaba,

Kod: 
Sub Makro1()
Dim oDoc As Document, docN As Document
Dim rCopy As Range, strTemplate As String
Dim k As Integer, i As Integer, sayfa_araligi As Variant
Dim son As Integer, say As Integer

Application.ScreenUpdating = False
Selection.HomeKey Unit:=wdStory
Set oDoc = ActiveDocument
strTemplate = oDoc.FullName

k = ActiveDocument.ComputeStatistics(wdStatisticPages)
sayfa_araligi = InputBox("Bu belgede " & k & " sayfa var", "Sayı girin")
If sayfa_araligi = 0 Or sayfa_araligi = "" Or Not IsNumeric(sayfa_araligi) Then
    MsgBox "Geçerli bir sayı giriniz", vbInformation
    Exit Sub
End If

For i = 1 To k Step sayfa_araligi
son = i + sayfa_araligi - 1
If son > k Then son = k
    Set rCopy = ActiveDocument.GoTo(What:=wdGoToPage, _
    Which:=wdGoToAbsolute, Count:=i)
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=son
    rCopy.End = Selection.Bookmarks("\Page").Range.End
    rCopy.Select
    rCopy.Copy
    Set docN = Documents.Add(Template:=strTemplate)
    docN.Range.Paste
    Selection.EndKey Unit:=wdStory
    docN.Range.Characters.Last.Delete
    docN.SaveAs ThisDocument.Path & "\Sayfa_" & i & "_" & son & ".docx"
    docN.Close
    say = say + 1
Next
Selection.HomeKey Unit:=wdStory
Application.ScreenUpdating = True

MsgBox say & "  adet belge başarıyla kaydedildi.", vbInformation, "DURUM"
End Sub
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst