word'de sayfaları ayrı dosya olarak kaydetmek?

A

abcd_efe

Katılım
13 Ocak 2005
Mesajlar
211
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
 
X

xp45s

Katılım
3 Şubat 2010
Mesajlar
158
Excel Vers. ve Dili
2003/ingilizce
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
 
leumruk

leumruk

Uzman
Uzman
Katılım
15 Nisan 2007
Mesajlar
3,469
Excel Vers. ve Dili
Office 2010 & 2013 tr
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
 
Y

yağız22

Katılım
24 Aralık 2009
Mesajlar
79
Excel Vers. ve Dili
excel 2007
Türkçe
dosya kaydederken sayfa adlarınıda yazdırabilirmiyiz.
 
S

shadow3804

Katılım
3 Ocak 2009
Mesajlar
1
Excel Vers. ve Dili
excel 2003
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?
 
leumruk

leumruk

Uzman
Uzman
Katılım
15 Nisan 2007
Mesajlar
3,469
Excel Vers. ve Dili
Office 2010 & 2013 tr
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.
 
E

emrahyzz

Katılım
18 Kasım 2014
Mesajlar
6
Excel Vers. ve Dili
c sharp
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.
 
D

Dorukkk

Katılım
29 Mart 2006
Mesajlar
7
Excel Vers. ve Dili
2003 TR
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.
 
leumruk

leumruk

Uzman
Uzman
Katılım
15 Nisan 2007
Mesajlar
3,469
Excel Vers. ve Dili
Office 2010 & 2013 tr
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.
 
C

cadiguzel

Katılım
25 Aralık 2007
Mesajlar
4
Excel Vers. ve Dili
2007
Altın Üyelik Bitiş Tarihi
01-04-2023
emeğiniz için teşekkürler
 
M

mars2

Altın Üye
Katılım
2 Eylül 2004
Mesajlar
553
Excel Vers. ve Dili
2016 - Türkçe
2019 - Türkçe
Altın Üyelik Bitiş Tarihi
26-03-2026
İ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?
 
S

sadoo123

Altın Üye
Katılım
22 Ağustos 2023
Mesajlar
12
Excel Vers. ve Dili
Office 365 Türkçe
Altın Üyelik Bitiş Tarihi
27-11-2024
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.
 
N

necati

Katılım
20 Şubat 2007
Mesajlar
517
Excel Vers. ve Dili
2007 Office, Tr
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.
Üst