sayfaları birleştirerek pdf kaydetme

[cem116]

Öncelikle tüm üstadlara merhaba Forumdaki üstadların yardımıyla daha önceden elimdeki dosyada bulunan sayfaları bir makro ile sayfa sayfa veya tüm sayfaları tek bir pdf dosyası olarak kaydedebileceğim iki makro oluşturmuştuk. Ancak şimdi yeni bir durum oluştu. Bu durumda excel dosyamda 9 sayfa var, bu sayfaların her hafta içerikleri değişecek ve pdf olarak kaydetmem gerekecek. Ancak sorun şu ki, ben bu sayfaları pdf e dönüştürdükten sonra, her bir sayfayı 9.sayfa ile birleştirmek zorundayım. Çünkü ilk 8 sayfadaki bilgiler farklı, 9.sayfa ise ortak. Özetle, ihtiyacım olan makronun, Sayfa1 ile sayfa9 i, Sayfa2 ile sayfa9,..... , sayfa8 ile sayfa9 i birleştirerek pdf halide kaydetmesi gerekiyor. Kaydettiği dosyalar için de dosya isimlerini 1'den 8'e kadar her sayfada B3 hücresinden alacak. pdf dosyalarının kaydedileceği klasör masaüstünde " PDF İÇERİK" ŞEKLİNDE BİR DOSYA OLACAK. Yardımlarınız için şimdiden teşekkürler. örnek dosya ektedir.

http://dosya.co/yukkp0bygawo/cem116örnek.xlsx.html

 

[supervisor]

Linkteki dosya boş bir excel kitabı. Geçerli çalışmanızı yükleyin, birleştirme ve dönüşüm için yardımcı olabilirim.

 

[cem116]

Çok teşekkürler. Ancak yüklediğim excel kitabı tamamen mi boş, yoksa örnek olarak yetersiz mi ? Çünkü normalde sayfaları isimlendirmiş, tam olarak neye ihtiyacımız olduğunu anlatmaya çalışmıştım içinde. Acaba yanlış dosya mı yükledim o nedenle soruyorum ? Yoksa kullanacagimiz dosyaya mi ihtiyacınız var ? Kullanacağımız dosyanın içeriğinin hazırlanması tam bitmedi daha ö yüzden yüklemedim. Yani o dosyada yapabilirseniz ben kodlarda degisiklik yapmam gerekirse elimden geldiğince yeni dosyaya uyarlarım diye düşünmüştüm. Ona göre size dönüş sağlayayım. Ya da bitirebilirsem bi iki saat içinde yükleyeyim hazır olan kısmını

 

[veyselemre]

Sub pdfExport()

    fPdfPath = "c:\users\user\Desktop\PDF\"
    shArray = Array("", "Sayfa9")
 
    For i = 1 To 8
        shArray(0) = "Sayfa" & i
        Sheets("Sayfa" & i).Activate
        fPdfName = fPdfPath & Range("B3") & ".pdf"
        Sheets(shArray).Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            fPdfName, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next i
    
End Sub

 

[cem116]

Sub pdfExport()

    fPdfPath = "c:\users\user\Desktop\PDF\"
    shArray = Array("", "Sayfa9")

    For i = 1 To 8
        shArray(0) = "Sayfa" & i
        Sheets("Sayfa" & i).Activate
        fPdfName = fPdfPath & Range("B3") & ".pdf"
        Sheets(shArray).Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            fPdfName, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next i
   
End Sub

Öncelikle ilginiz için teşekkürler. Ancak bu kodu kullandığımda out of range gibi bir uyarı aldım. acaba kodu yanlış bir yere mi kopyaladım ?

 

[veyselemre]

Ekteki dosyada çalışıyor. pdf klasörünün ismini, sayfa isimlerini (Sayfa1, Sayfa2... Sayfa9 şeklinde olmalı). Dosyanızda adım adım çalıştırın nerede hata verdiğini kontrol edin.

 

[cem116]

Linkteki dosya boş bir excel kitabı. Geçerli çalışmanızı yükleyin, birleştirme ve dönüşüm için yardımcı olabilirim.

Üstad hem sizin için hem de yardımcı olabilecek diğer arkadaşlar için, dosyamın tasarlayabildiğim kadarını tekrar ekliyorum. Umarım bu haliyle destek olabilirsiniz bana. dosyanın içinde tam olarak neye ihtiyacım olduğunu bir kez daha detaylı olarak yazdım. ilgilenen ve yardımcı olanlara şimdiden teşekkürler.

http://www.dosya.tc/server17/hz27mt/cemornekdosya.xlsx.html

 

[cem116]

Ekteki dosyada çalışıyor. pdf klasörünün ismini, sayfa isimlerini (Sayfa1, Sayfa2... Sayfa9 şeklinde olmalı). Dosyanızda adım adım çalıştırın nerede hata verdiğini kontrol edin.

Üstad hızlı yanıt için çok teşekkürler. Sizin gönderdiğini dosya bende de sorunsuz çalıştı. ama ben tam nasıl uyarlayabilirim bilemedim benim dosyam aşağıdaki gibi. size zahmet verdiğimin farkındayım ama, bu dosyaya göre ne yapmam gerekiyor acaba ? bir de sayfa isimlerini daha sonra değiştirmem gerekirse, kodda nasıl düzenlemeliyim. ? kısaca açıklayabilir misiniz?


http://www.dosya.tc/server17/hz27mt/cemornekdosya.xlsx.html

 

[veyselemre]

Sub pdfExport()

    fPdfPath = "c:\users\user\Desktop\PDF\"
    shArray = Array("", "ödev")
 
    For i = 1 To 8
        shArray(0) = Trim(i)
        Sheets(Trim(i)).Activate
        fPdfName = fPdfPath & Range("a2") & ".pdf"
        Sheets(shArray).Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            fPdfName, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next i
    
End Sub

 

[cem116]

Hiç aklıma gelmeyen bir sorun oluşuyor dosyanızda, Sheets(i).Activate dediğimizde i=1 olduğunda normalde sayfa ismi olan 1 i kastediyoruz, ama excel bunu index olarak algılıyor ve dosyanızda ilk sırada bulunan Bilgi Giriş sayfasını 1 nci sayfa olarak görüyor ve hatalı işlem oluşuyor.

Kodları çalıştırmadan önce 2 seçenekten birisini uygulayınız.
1-Bilgi giriş sayfasını en son sekmeye taşıyın, sekmelerin sıralaması 1 den 8 e kadar devam etsin,
2-İlgili sayfaların ismini s1 - s2 ... s8 vb şekilde değiştirin.

Sub pdfExport()

    fPdfPath = "c:\users\user\Desktop\PDF\"
    shArray = Array("", "ödev")

    For i = 1 To 8
        shArray(0) = i
        'Sheets("s" & i).Activate
        Sheets(i).Activate
        fPdfName = fPdfPath & Range("a2") & ".pdf"
        Sheets(shArray).Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            fPdfName, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next i
   
End Sub

Çok teşekkür ederim, şimdi çıkmam gerekiyor bir hastane işi için. Ancak akşam bakabileceğim sanırım. Son durumu buradan mutlaka bildireceğim. İlginiz ve desteğiniz için çok teşekkürler.

 

[veyselemre]

Yukardaki kodlarda düzenleme yaptım, trim(i) şeklinde stringe çevirince sorun ortadan kalktı.

 

[cem116]

Yukardaki kodlarda düzenleme yaptım, trim(i) şeklinde stringe çevirince sorun ortadan kalktı.

Üstad eline sağlık, teşekkür ederim. ortak sayfayı da yeniden pdf yapıyor olsa da kod, benim işimi görüyor açıkcası. daha fazlasını istemek ayıp olur elinize sağlık. Sayfa numaralarında bir iki küçük değişiklik yaptım kodun genel yapısını etkilemeyecek. şuan sorunsuz çalışıyor, dediğim gibi son sayfayı da pdf yapıyor bir daha ama o çok büyük bir dert değil. klasöre attıktan sonra sileriz olur biter Tekrar teşekkürler

 

[halit3]

Alternatif kod

Sub pdfaktar()

Application.ScreenUpdating = False
yer = ActiveSheet.Name
For i = 1 To ActiveWorkbook.Sheets.Count
If Sheets(i).Visible = False Then GoTo atla
If Sheets(i).Name = "BİLGİ GİRİŞ" Then GoTo atla
If Sheets(i).Name = "ödev" Then GoTo atla

Sheets(Array("ödev", Sheets(i).Name)).Select

dosya_adı = Sheets(Sheets(i).Name).Cells(2, 1).Value

Application.DisplayAlerts = False
yol = ThisWorkbook.Path
say = CreateObject("Scripting.FileSystemObject").getfolder(yol).Files.Count + 1

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=yol & "\" & dosya_adı & " " & say & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

Application.ScreenUpdating = True

atla:
Next i

Sheets(yer).Select
MsgBox "İşlem Tamam", vbInformation, " U Y A R I "

End Sub

 

[cem116]

Alternatif kod

Sub pdfaktar()

Application.ScreenUpdating = False
yer = ActiveSheet.Name
For i = 1 To ActiveWorkbook.Sheets.Count
If Sheets(i).Visible = False Then GoTo atla
If Sheets(i).Name = "BİLGİ GİRİŞ" Then GoTo atla
If Sheets(i).Name = "ödev" Then GoTo atla

Sheets(Array("ödev", Sheets(i).Name)).Select

dosya_adı = Sheets(Sheets(i).Name).Cells(2, 1).Value

Application.DisplayAlerts = False
yol = ThisWorkbook.Path
say = CreateObject("Scripting.FileSystemObject").getfolder(yol).Files.Count + 1

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=yol & "\" & dosya_adı & " " & say & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

Application.ScreenUpdating = True

atla:
Next i

Sheets(yer).Select
MsgBox "İşlem Tamam", vbInformation, " U Y A R I "

End Sub

üstad çok teşekkürler. gayet güzel çalışıyor bu kod da. Elleriniz dert görmesin. yalnız dosya isimlerini alırken neden sadece ilk sayfanın "a2" hücresinde yazanları da almıyor acaba? dosya isimleri benim uyguladığım dosyada biraz daha farklı oldu nedense. yani yanına sayı ekledi. Gerçi sorun teşkil eden bir şey değil, dosya isminde ilk sayfaya göre bir ismin geçmesi yetiyor bana ama dosya adının önem arz ettiği durumlarda sorun olur mu acaba diye düşündüm. Bir de "bilgi girişi" ve "ödev" sayfalarını da birleştiriyor. oysa bilgi girişi veya ödev sayfalarıyla birlikte ya da ayrı hiçbir işimiz yok aslında. "bilgi girişi" dışındaki tüm sayfaların "ödev" sayfasıyla birleşip pdf olması yeterli. ama nedense "bilgi girişi" ile "ödev" i de birleştiriyor. teknik olarak böyle olmak zorundaysa sorun değil, ama engellenebilir mi diye merak ettim. Sayfa adı girerek işlem yapması bence kodun en muhteşem tarafı, çünkü bir başka dosyada denedim, ilgili kısımlara sayfa isimlerini girmem yeterli oldu kodun bu dosya için de aynı şekilde çalışması için. Kod böylelikle başka dosyalar için de kolayca uyarlanabilen bir kod olmuş. Bu nedenle de ayrıca tebrik ederim. Elleriniz dert görmesin

 

[halit3]

Bir de "bilgi girişi" ve "ödev" sayfalarını da birleştiriyor

(Bir de "bilgi girişi" ve "ödev" sayfalarını da birleştiriyor )
Kod bunları birleştirmiyor. Dosyada 10 sayfa var ikisini çıkartınca 8 sayfa kalır bu da 8 dosya yapar.
Diğer taraftan sayı vermesinin sebebi her kayıt da farklı isim vermesi için yoksa eskisinin üzerine yazması gerekiyor.
dosya isimleri hangi hücreden alacaksa oda düzenlenir.

 

[cem116]

(Bir de "bilgi girişi" ve "ödev" sayfalarını da birleştiriyor )
Kod bunları birleştirmiyor. Dosyada 10 sayfa var ikisini çıkartınca 8 sayfa kalır bu da 8 dosya yapar.
Diğer taraftan sayı vermesinin sebebi her kayıt da farklı isim vermesi için yoksa eskisinin üzerine yazması gerekiyor.
dosya isimleri hangi hücreden alacaksa oda düzenlenir.

Günaydın Sayfalara numara verme kısmındaki mantığınızı şimdi anladım. Ben dosyaları pdf olarak kaydettikten sonra bulunduğu klasörden alıyorum zaten o yüzden mükerrer kayıt olmayacağı için o kısmı düşünmemiştim. Dediğiniz doğru, farklı bir kullanım söz konusu olduğunda numaralı olması mantıklı evet. Ancak "bilgi giriş" ve "ödev" sayfalarını birleştirme kısmını bir kez daha denedim. Maalesef birleştiriyor. Kodda sadece sayfa isimlerini değiştirdim başka bir değişiklik yapmadım aslında ama belki de bu sorun benden kaynaklıdır. Farkında olmadan başka bir şey yapmış olabilirim. Belki de sayfa sayısıyla ilgili bir farklılık vardır. Onu henüz incelemedim. Ama daha önce de söylediğim gibi birleştirmesi sorun teşkil eden bir durum da değil aslında. Desteğiniz ve emekleriniz için çok teşekkür ederim. İyi çalışmalar, iyi günler dilerim

 

[halit3]

1 nolu mesajınızdaki dosyada kodları denedim "bilgi giriş" ve "ödev" sayfaları birleşmiyor
kodun bu kısmında pdf yapmak için bu sayfaların sırası geldiğinde pas geçiyor yani kod bu bölümde bir işlem yapmıyor.
If Sheets(i).Name = "BİLGİ GİRİŞ" Then GoTo atla
If Sheets(i).Name = "ödev" Then GoTo atla

1 nolu mesajınızdaki dosyada kodları çalıştırın ve irdeleyiniz.
veya dosyanızda bu iki sayfa dışındaki sayfaları silin ve kodu çalıştırın hiç bir işlem yapmıyacaktır.

 

[cem116]

1 nolu mesajınızdaki dosyada kodları denedim "bilgi giriş" ve "ödev" sayfaları birleşmiyor
kodun bu kısmında pdf yapmak için bu sayfaların sırası geldiğinde pas geçiyor yani kod bu bölümde bir işlem yapmıyor.
If Sheets(i).Name = "BİLGİ GİRİŞ" Then GoTo atla
If Sheets(i).Name = "ödev" Then GoTo atla

1 nolu mesajınızdaki dosyada kodları çalıştırın ve irdeleyiniz.
veya dosyanızda bu iki sayfa dışındaki sayfaları silin ve kodu çalıştırın hiç bir işlem yapmıyacaktır.

Üstad, sanırım ben sizin düzenledim dediğiniz mesajı atlamışım ısrarla eski kodu deniyormuşum. Sayfadan bir kez daha kopyalayıp kod kısmına yapıştırınca herhangi bir sorun yaşamadım. Tekrar tekrar ellerinize sağlık

Not: Bu mesaji aslında cuma akşamı yazdım sanıyordum ama sanırım çocuklar kafa bırakmadığı için cevaı gönder dememişim. şimdi sayfaya tekrar girdiğimde fark ettim. Kusura bakmayın. Bu durumu bir kez daha yaşamıştım daha önce, gönderdim sandığım mesajı göndermemişim. Yaptığınız yardıma karşılık geri bildirim alamamak hoş bir durum değil tahmin edebiliyorum. Ancak dediğim gibi benimki ufaklıkların kafa karıştırmasından kaynaklı. Kusura bakmayın, tekrar teşekkürler, iyi günler

 

[mrwarrior]

Bu kod ile

Alternatif kod

Sub pdfaktar()

Application.ScreenUpdating = False
yer = ActiveSheet.Name
For i = 1 To ActiveWorkbook.Sheets.Count
If Sheets(i).Visible = False Then GoTo atla
If Sheets(i).Name = "BİLGİ GİRİŞ" Then GoTo atla
If Sheets(i).Name = "ödev" Then GoTo atla

Sheets(Array("ödev", Sheets(i).Name)).Select

dosya_adı = Sheets(Sheets(i).Name).Cells(2, 1).Value

Application.DisplayAlerts = False
yol = ThisWorkbook.Path
say = CreateObject("Scripting.FileSystemObject").getfolder(yol).Files.Count + 1

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=yol & "\" & dosya_adı & " " & say & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

Application.ScreenUpdating = True

atla:
Next i

Sheets(yer).Select
MsgBox "İşlem Tamam", vbInformation, " U Y A R I "

End Sub

Bu kod ile birden fazla sayfayı tek pdf yapabilir miyim?