• DİKKAT

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

Makro ile belli formatta dosya oluşturmak

L

lcdvscrt

Katılım
1 Aralık 2010
Mesajlar
9
Excel Vers. ve Dili
2007 English
Merhaba,

Yapmak istediğim şey biraz detaylı olduğu için uzun olacak ama adımları tek tek anlatmaya çalışacağım:

Elimde yaklaşık 10 sütunlu bir tablo içinde 100'e yakın kayıt olan bir data var. Bu dataları, yine excel içinde hazırlanmış çıktı alınabilecek bir sayfa içine, her bir satır bir sayfa oluşturacak şekilde, makro ile kopylayayıp her biri için bir PDF dosyası oluşturmak istiyorum.

Başka bir deyişle, tablodaki A2, B2, C2,...... J2 verilerini diğer sayfadaki tablo içine B2, B4, B6,.......... B20 şeklinde kopyalamak istiyorum. Tabi bunu her satır için yapacağım düşünüldüğünde 100'e yakın bir sayfa olmuş oluyor.

Daha sonra oluşan her bir sayfayı PDF formatında kaydedip 100'e yakın çıktı alınabilecek bir sayfa elde etmek istiyorum.

Anlattığım işlemlerin hepsini aslında tek bir kayıt için yapabiliyorum. Ama benim istediğim, makroyu çalıştırdıktan sonra tablodaki bütün kayıtlar için yeni bir sayfa oluşturup PDF olarak kaydedebilmek. Ayrıca bu dosyaların sırasıyla 1, 2, 3,..... 100 şeklinde kaydedilebilmesini istiyorum.

Yardımlarınızı bekliyorum...
 
Anlattıklarım biraz soyut kaldı sanırım. O yüzden örnek dosya oluşturdum.

Ekteki dosyada "DATA" çalışma sayfası içindeki tüm kayıtları sırasıyla "New" çalışma sayfasındaki formata uygun olarak aktarıp "New" çalışma sayfasını PDF formatına dönüştürerek kaydetmek istiyorum.

Bu işlemi her bir kayıt için yaparak, her kaydın ayrı bir PDF dosyası olarak saklanmasını istiyorum.
 

Ekli dosyalar

lcdvscrt' Alıntı:
Anlattıklarım biraz soyut kaldı sanırım. O yüzden örnek dosya oluşturdum.

Ekteki dosyada "DATA" çalışma sayfası içindeki tüm kayıtları sırasıyla "New" çalışma sayfasındaki formata uygun olarak aktarıp "New" çalışma sayfasını PDF formatına dönüştürerek kaydetmek istiyorum.

Bu işlemi her bir kayıt için yaparak, her kaydın ayrı bir PDF dosyası olarak saklanmasını istiyorum.
Genişletmek için tıkla ...

bu kadu denermisiniz.

Kod: 
Sub aktar()
For i = 3 To Worksheets("DATA").Cells(Rows.Count, "B").End(3).Row
Sheets("New").Cells(3, 2).Value = Sheets("DATA").Cells(i, 1).Value
Sheets("New").Cells(5, 2).Value = Sheets("DATA").Cells(i, 2).Value
Sheets("New").Cells(7, 2).Value = Sheets("DATA").Cells(i, 3).Value
Sheets("New").Cells(11, 2).Value = Sheets("DATA").Cells(i, 4).Value
Sheets("New").Cells(9, 2).Value = Sheets("DATA").Cells(i, 5).Value
Sheets("New").Cells(13, 2).Value = Sheets("DATA").Cells(i, 6).Value
Sheets("New").Cells(17, 2).Value = Sheets("DATA").Cells(i, 7).Value
Sheets("New").Cells(19, 2).Value = Sheets("DATA").Cells(i, 8).Value
Sheets("New").Cells(3, 6).Value = Sheets("DATA").Cells(i, 9).Value
Sheets("New").Cells(15, 2).Value = Sheets("DATA").Cells(i, 10).Value
dosya_adı = Sheets("New").Cells(3, 6).Value
ekle = Format(Now, " dd_mm_yyyy_hh_mm_ss")
Sheets("New").Range("A1:H21").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Application.ThisWorkbook.Path & "\" & dosya_adı & ekle, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next i
MsgBox "İŞLEM TAMAM"
End Sub
 
Cevap için teşekkürler.
Vermiş olduğunuz kodu biraz değiştirerek çalışmak istediğim dosya üzerinde uygulamaya çalıştım. Ancak bazı sorunlarım var:

1. Makroyu çalıştırdığımda dosyalar sorunsuz oluşturuluyor ama makro bittiğinde "document not saved" şeklinde hata alıyorum.

2. Bazı kayıtlar çok uzun metinler içerdiği için, yeni sayfadaki hücrelere sığmıyor ve PDF dosyasında yazıların sadece bir kısmı gözüküyor. Yani hücreler otomatik olarak genişlemiyor. Hücrelerin otomatik olarak genişlememesinin sebebi sanırım birleştirilmiş birkaç hücre olması. Bu hücreleri otomatik olarak nasıl genişletebiliriz?

Ekteki dosyada makro ve çalışmakta olduğum format mevcut...

Kod: 
Sub aktar()
For i = 2 To Worksheets("Tablo1").Cells(Rows.Count, "B").End(2).Row
Sheets("Yeni_Sayfa").Cells(8, 3).Value = Sheets("Tablo1").Cells(i, 1).Value
Sheets("Yeni_Sayfa").Cells(10, 3).Value = Sheets("Tablo1").Cells(i, 2).Value
Sheets("Yeni_Sayfa").Cells(3, 5).Value = Sheets("Tablo1").Cells(i, 3).Value
Sheets("Yeni_Sayfa").Cells(12, 3).Value = Sheets("Tablo1").Cells(i, 4).Value
Sheets("Yeni_Sayfa").Cells(14, 3).Value = Sheets("Tablo1").Cells(i, 5).Value
Sheets("Yeni_Sayfa").Cells(16, 3).Value = Sheets("Tablo1").Cells(i, 6).Value
Sheets("Yeni_Sayfa").Cells(18, 3).Value = Sheets("Tablo1").Cells(i, 7).Value
Sheets("Yeni_Sayfa").Cells(20, 3).Value = Sheets("Tablo1").Cells(i, 8).Value
Sheets("Yeni_Sayfa").Cells(22, 3).Value = Sheets("Tablo1").Cells(i, 9).Value
Sheets("Yeni_Sayfa").Cells(24, 3).Value = Sheets("Tablo1").Cells(i, 10).Value
Sheets("Yeni_Sayfa").Cells(4, 5).Value = Sheets("Tablo1").Cells(i, 11).Value
dosya_adı = Sheets("Tablo1").Cells(i, 11).Value
Sheets("Yeni_Sayfa").Range("A1:F30").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Application.ThisWorkbook.Path & "\" & dosya_adı, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next i
MsgBox "Kopyalama Tamamlandı!"
End Sub
 

Ekli dosyalar

lcdvscrt' Alıntı:
Cevap için teşekkürler.
Vermiş olduğunuz kodu biraz değiştirerek çalışmak istediğim dosya üzerinde uygulamaya çalıştım. Ancak bazı sorunlarım var:

1. Makroyu çalıştırdığımda dosyalar sorunsuz oluşturuluyor ama makro bittiğinde "document not saved" şeklinde hata alıyorum.

2. Bazı kayıtlar çok uzun metinler içerdiği için, yeni sayfadaki hücrelere sığmıyor ve PDF dosyasında yazıların sadece bir kısmı gözüküyor. Yani hücreler otomatik olarak genişlemiyor. Hücrelerin otomatik olarak genişlememesinin sebebi sanırım birleştirilmiş birkaç hücre olması. Bu hücreleri otomatik olarak nasıl genişletebiliriz?

Ekteki dosyada makro ve çalışmakta olduğum format mevcut...

Kod: 
Sub aktar()
For i = 2 To Worksheets("Tablo1").Cells(Rows.Count, "B").End(2).Row
Sheets("Yeni_Sayfa").Cells(8, 3).Value = Sheets("Tablo1").Cells(i, 1).Value
Sheets("Yeni_Sayfa").Cells(10, 3).Value = Sheets("Tablo1").Cells(i, 2).Value
Sheets("Yeni_Sayfa").Cells(3, 5).Value = Sheets("Tablo1").Cells(i, 3).Value
Sheets("Yeni_Sayfa").Cells(12, 3).Value = Sheets("Tablo1").Cells(i, 4).Value
Sheets("Yeni_Sayfa").Cells(14, 3).Value = Sheets("Tablo1").Cells(i, 5).Value
Sheets("Yeni_Sayfa").Cells(16, 3).Value = Sheets("Tablo1").Cells(i, 6).Value
Sheets("Yeni_Sayfa").Cells(18, 3).Value = Sheets("Tablo1").Cells(i, 7).Value
Sheets("Yeni_Sayfa").Cells(20, 3).Value = Sheets("Tablo1").Cells(i, 8).Value
Sheets("Yeni_Sayfa").Cells(22, 3).Value = Sheets("Tablo1").Cells(i, 9).Value
Sheets("Yeni_Sayfa").Cells(24, 3).Value = Sheets("Tablo1").Cells(i, 10).Value
Sheets("Yeni_Sayfa").Cells(4, 5).Value = Sheets("Tablo1").Cells(i, 11).Value
dosya_adı = Sheets("Tablo1").Cells(i, 11).Value
Sheets("Yeni_Sayfa").Range("A1:F30").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Application.ThisWorkbook.Path & "\" & dosya_adı, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next i
MsgBox "Kopyalama Tamamlandı!"
End Sub
Genişletmek için tıkla ...

Göndermiş olduğun dosyada hiç veri yok veri olmadığı için hiç birşey aklıma gelmiyor hayali bir verileriniz olsun sığmıyan verinin durumunu görelim bakalım.
 
Ekteki dosyada ilk satır için öylesine veri girdim. Mesela "H" sütunundaki metin, makro ile aktarılınca çıkan PDF dosyasında yarım olarak gözüküyor. (H sütunu dşındakiler için de aynı sonuç geçerli) PDF dosyasında, hücre içindeki bilgilerin tamamının gözükmesi gerekiyor. Gerekirse 1 sayfayı aşmasında bir sorun yok.

Ayrıca makro sona erince tüm satırlar için dosya oluşturmasına rağmen hata mesajı da çıkıyor.
 

Ekli dosyalar

şimdi iş yerindeki bilgisayarda ofis2007 yok evde boş kaldığım zaman bakacağım.
ancak kodları değiştirirken hata yapmışınız.

For i = 2 To Worksheets("Tablo1").Cells(Rows.Count, "B").End(3).Row
Genişletmek için tıkla ...

kırmızı işaretli yer sizdekinde 2 olarak gözüküyor onu 3 olarak düzeltiniz.
 
Kod: 
For i = 2 To Worksheets("Tablo1").Cells(Rows.Count, "B").End(3).Row
Buradaki "3" rakamı neyi ifade ediyor?

Bir de değişiklik yaptığım kodda iki hücrenin yerini karıştırmışım. Doğrusu şöyle:

Kod: 
Sub aktar()
For i = 2 To Worksheets("Tablo1").Cells(Rows.Count, "B").End(3).Row
Sheets("Yeni_Sayfa").Cells(8, 3).Value = Sheets("Tablo1").Cells(i, 1).Value
Sheets("Yeni_Sayfa").Cells(10, 3).Value = Sheets("Tablo1").Cells(i, 2).Value
Sheets("Yeni_Sayfa").Cells(4, 5).Value = Sheets("Tablo1").Cells(i, 3).Value
Sheets("Yeni_Sayfa").Cells(12, 3).Value = Sheets("Tablo1").Cells(i, 4).Value
Sheets("Yeni_Sayfa").Cells(14, 3).Value = Sheets("Tablo1").Cells(i, 5).Value
Sheets("Yeni_Sayfa").Cells(16, 3).Value = Sheets("Tablo1").Cells(i, 6).Value
Sheets("Yeni_Sayfa").Cells(18, 3).Value = Sheets("Tablo1").Cells(i, 7).Value
Sheets("Yeni_Sayfa").Cells(20, 3).Value = Sheets("Tablo1").Cells(i, 8).Value
Sheets("Yeni_Sayfa").Cells(22, 3).Value = Sheets("Tablo1").Cells(i, 9).Value
Sheets("Yeni_Sayfa").Cells(24, 3).Value = Sheets("Tablo1").Cells(i, 10).Value
Sheets("Yeni_Sayfa").Cells(3, 5).Value = Sheets("Tablo1").Cells(i, 11).Value
dosya_adı = Sheets("Tablo1").Cells(i, 11).Value
Sheets("Yeni_Sayfa").Range("A1:F30").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Application.ThisWorkbook.Path & "\" & dosya_adı, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next i
MsgBox "Kopyalama Tamamlandı!"
End Sub
 
Cevap için çok teşekkür ederim. Şu an hücreler taşmadan dosya alabiliyorum. Yalnız birkaç sorunum daha var:

Makroyu çalıştırınca "Yeni_sayfa" çalışma sayfasında "H" deki metin uzun da olsa gözüküyor ancak diğer kısımlarda aynı sorun devam ediyor. "H" dışındaki kısımlara da uzun metinler gelebiliyor. Dolayısıyla "I", "J" gibi kısımlar için de otomatik genişletme yapılması gerekiyor. Oradaki metinlerin de tamamının görünmesi lazım.

Bir de en son gönderdiğiniz dosyada "H" bölümünün orjinal yüksekliği değişmiş. Benim istediğim orjinal boyutunun aynı kalması çünkü bazen kısa metinler de gelebiliyor. O zaman boşuna çok büyük satır yüksekliği ortaya çıkmış oluyor.

Ayrıca en son makrodan aldığım PDF'ler A4 kağıt boyutundan biraz küçük çıkıyor. Yani orjinaldeki gibi sayfanın tamamını kaplayıp ortada çıkmıyor.

Çok fazla başınızı ağrıttım ama bu sorunları da çözebilirseniz benim için çok büyük bir iyilik yapmış olacaksınız :)
 
ekli dosyaya bir bakınız.
 

Ekli dosyalar

Satır yüksekliklerindeki ufak tefek farklar dışında şu an istediğim gibi oldu. Onları da ben üzerinde oynayarak düzeltmeye çalışıcam. Takıldığım bi yer olursa tekrar cevap yazarım.

İlginiz için çok teşekkür ederim.
 
lcdvscrt' Alıntı:
Satır yüksekliklerindeki ufak tefek farklar dışında şu an istediğim gibi oldu. Onları da ben üzerinde oynayarak düzeltmeye çalışıcam. Takıldığım bi yer olursa tekrar cevap yazarım.

İlginiz için çok teşekkür ederim.
Genişletmek için tıkla ...

İyi çalışmalar
 
Az önce dünkü dosyadaki makroyu uygulamaya çalıştım. Dün farketmemiştim ama çok uzun metinlerde yine sığmama problemi yaşıyorum.

Belli bir orana kadar metinler sığıyor ama belli karakteri geçince yine sığmamaya başlıyor. Ekteki dosyada 5 tane örnek kayıt girdim. 1. kayıt sığmayan kayıt. Diğerleri sığabilen kayıtlar.

Bir de makro sonucunda elde edilen PDF dosyalarının kenar boşlukları çok fazla oluyor. Dolayısıyla içindeki alan da daralmış oluyor. Karşılaştırma yapabilmeniz için örnek bir sayfa düzenini de ekteki dosya içinde gönderiyorum. Yeni oluşturulan sayfaların da kenar boşlukları ve boyutu örnek sayfadaki gibi olursa benim için daha iyi olur.

Bu arada çok uzun metinler olduğunda sayfa çok fazla küçülüyor ve okunabilirliği azalıyor. Sayfanın tamamının ölçeğini küçültmek yerine kenar boşluklarını da sabit tutup sadece uzun metin içeren (son 3 satır) hücrelerin fontunu küçültebilir miyiz? Yani kısa metin olduğunda fontu orjinal, uzun metin gelirse otomatik olarak sığabilecek şekilde küçülmüş bir font olabilir.

Ya da tüm bunlar dışında çok uzun metin içeren sayfalarda font ve sayfa oranını koruyup, 1 sayfa yerine 2. sayfaya da geçme gibi bir şansımız var mı acaba? Eğer uzun metinlerde 2. sayfaya geçebilirsek sayfa sıkışmamış olur ve daha hoş görünür diye düşünüyorum.
 

Ekli dosyalar

Bu arada yazmayı unutmuştum. Yeni oluşturulan Excel sayfası, yazdırma özelliklerinde 1 sayfaya sığdırılacak şekilde ayarlanmış. Onu, orjinal boyutunun %65'i olarak değiştirirsek 2. sayfaya da geçiyor. Kenar boşlukları da istenilen düzeyde oluyor.

Yani bu şekilde yaptığımızda tek sorun, metnin tüm hücrelere (özellikle son 3 hücreye) eksiksiz sığması.
 
Bu format benim de çok işime yarayacak. Talep eden ve yardımcı olan tüm arkadaşlara teşekkür ederim. Bu satırların tümünü örneğin 150 satır; 150 adet sayfayı tek pdf yapmak için kodda nasıl bir değişiklik yapılabilir acaba?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst