Boşluk Doldurmalı Print Alanı

[baydeniro]

Merhaba arkadaşlar. Verilerin kolon kolon olduğu bir datada print alırken olmayan kolonların yerini alttan doldururarak print alınması yani kağııta boşluk bırakılmaması mümkün mü ? Örnek ekteki dosyada.

 

[baydeniro]

Merhaba arkadaşlar. Verilerin kolon kolon olduğu bir datada print alırken olmayan kolonların yerini alttan doldururarak print alınması yani kağııta boşluk bırakılmaması mümkün mü ? Örnek ekteki dosyada.

 

[Mahmut Kök]

Merhaba, sorunuzu tam olarak anlayamadığımı öncelikle belirtmek isterim. Anladığım kadarıyla sormak istiyorum: Mesela bir sütunda 15 satır, diğer sütunda ise 5 satır veri mevcut. Bu durumda siz, 15 satırlık verinin olduğu sütundan 5 satırı, 5 satır verinin olduğu sütunun altına ekleyip her iki sütundaki satır sayısını 10 yapmak, yani eşitlemek ve sonra mı yazıcıdan çıktı almak istiyorsunuz?

İsteğini biraz daha açarsanız, yardımcı olmaya çalışalım. İyi çalışmalar dilerim.

 

[baydeniro]

Merhaba mesleki. İlginiz için teşekkürler. Sorum şöyle :

A kolonunda 50 satır dolu. Print alanına 15 satır giriyor. Print alacağımız zaman 50 satır; 15 + 15 + 15 + 5 olarak ve 4 ayrı sayfa halinde çıkacak. Benim yapmak istediğim makro yardımı ile bu 15-15-15-5 lik verileri tek bir
sayfa yazdırmak (print almak). Yani görüntünün şu şekilde olması :

A M AB AP
B N AC AR
C O AD AS
Ç Ö AE AŞ
D P AF AT
E R AG
F S AH
G Ş AI
Ğ T Aİ
H U AJ
I Ü AK
İ V AL
J Y AM
K Z AN
L AA AO

 

[mrttrn]

Private Sub CommandButton1_Click()
Set DT = Worksheets("DATA")
Dim i, sf '1 sayfa 54 satır.Ön izleme de
sf = WorksheetFunction.CountA(DT.Range("A:A")) / 54 'A sutunundaki elemanları say. 54 e böl.

If sf > 1 Then 'birden fazla sayfa varsa.
For i = 1 To Int(sf) 'Int tam kısımı bulan fonk. Ör: Int(2,59)=2
DT.Range("A" & 54 * i + 2, "B" & 54 * i + 54 + 1).Select
DT.Range("A" & 54 * i + 2, "B" & 54 * i + 54 + 1).Copy
DT.Cells(2, 2 * i + 1).PasteSpecial Paste:=xlValues 'değerleri yapıştır
Next
DT.PrintPreview 'ÖN İZLEME
End If
End Sub


sayın serdar okan; 1 sayfa ön izlemede 54 satır. Commandbutton1 e atanmış olan Yukarıdaki kodla , A sutununda,her 54 satır sırasıyla C2-D2,E2-F2 ... sutunlarına aktarılıyor.Ancak ön izlemede 55.satır ve daha sonrası görünüyor.

Siz bunları yeni bir sayfaya aktarırsanız.Hepsi 1. - 55.satır arasına yerleşir. Önizleme sorun çıkarmaz.

ayrıca;
PrintArea komutunuda kullanabilirsiniz.Bunla yazdırma alanını belirtebilirsiniz. Ben tam bilmiyorum.

Yaptığım düzenleme ilişikteki dosyanıza uygulandı.

 

[baydeniro]

Teşekkürler

Sayın mrttrn yardımınız için çok teşekkürler. Makronun kolon sayısını kendisini algılayıp diyelimki 3 kolon varsa makro 3 kolona göre çalışsın, 4 kolon varsa 4 kolona göre çalışsın. böyle bir şey yapılabilir mi. Olmuyorsa yine de teşekkürler. Bu haliyle de bir süre işimizi görür. İleride bir çaresine bakarız. Elleriniz dert görmesin, sağlıcakla kalın.

 

[mrttrn]

Private Sub CommandButton1_Click()
Set DT = Worksheets("DATA")
Set DTP = Worksheets("DATA-PRNT")
Dim i, sf '1 sayfa 54 satır.Ön izleme de
Dim st 'sutun sayısı için
sf = WorksheetFunction.CountA(DT.Range("A:A")) / 54 'A sutunundaki elemanları say. 54 e böl.

'2.satırdaki daki eleman sayısı=sutun sayısı
'A2ile 50. sutunun 2. satırı arası
st = WorksheetFunction.CountA(DT.Range(Cells(2, 1), Cells(2, 50)))

'sanki excel sayfasında ki gibi işlem yapıyoruz.İlK 1.-55.satır kopyalanıyor.
DT.Select
DT.Range(Cells(1, 1), Cells(55, st)).Select 'seç.
DT.Range(Cells(1, 1), Cells(55, st)).Copy
DTP.Select
DTP.Range("A1").PasteSpecial Paste:=xlValues 'değerleri yapıştır
DTP.Columns.AutoFit 'sutunları değerlere göre genişlet.

If sf > 1 Then 'birden fazla sayfa varsa.
For i = 1 To Int(sf) 'Int tam kısımı bulan fonk. Ör: Int(2,59)=2
DT.Select
DT.Range("A" & 54 * i + 2, "B" & 54 * i + 54 + 1).Select
DT.Range("A" & 54 * i + 2, "B" & 54 * i + 54 + 1).Copy
DTP.Select
DTP.Cells(2, st * i + 1).PasteSpecial Paste:=xlValues 'değerleri yapıştır
DTP.Columns.AutoFit 'sutunları değerlere göre genişlet.
Next
DTP.Range("A1").Select
DTP.PrintPreview 'DATA_PRNT nin ÖN İZLEME si
DTP.Columns.Clear
End If
End Sub


yanyana aynı hizada kaç sutun varsa ona göre uyguladım.İnşallah olmuştur.
ilişikteki dosyada uyguladım.

 

[baydeniro]

Sayın mrttrn ilginiz ve sabrınız için ok teşekkürler. Bu biraz daha iyi olmuş. Ancak bizim istediğimiz şekli sizin son dosyanızın üstüne ekledim. Aşağıdaki dosyayı inceleyeince konunun daha iyi netleceğini düşünüyorum. Teşekkür ederim.

 

[baydeniro]

Arkadaşlar bu konuda yardımcı olmaya çalıştılar. Ancak herhalde ben soruyu iyi kurgulayamamışım. Sorum şu şekilde : Diyelim ki sadece A kolonunda 300 adet veri var. 1 sayfaya 50 adet veri sığdığını var sayarasak normal Print Area tanımı ile buradan 6 sayfa oluşur. Benim istediğim şu. Print alırken tüm 6 sayfayı tek 1 sayfada göstersin. Yani Print sayfasında 1. sayfanın yanında 2. 3. 4. 5. ve 6. sayfalar aynı sayfada print edilebilsin.

Sonra diyelimki A ve B kolonları 300'er veri ile dolu olsun. Bu durumda yine 6 sayfa söz konusudur. Aynı makro bu sefer verileri 1. print sayfasında A 1. sayfa - B 1.sayfa - A 2.sayfa - B 2.sayfa - A 3.sayfa - B 3. sayfa olmalı. 2. print sayfasında A ve B nin 4. 5. ve 6. sayfaları olmalı.

Bilmiyorum çok mu karışık oldu.

 

[mrttrn]

yazı karakterleri normalde 12pt idi. 3 pt yapılırsa, sutunlar autofit ile otomatik daralırsa.Font genişliği 1/4 oranında daralabilir.
Sayfada iyice küçülür.
Acaba olur mu diye aklıma geldi.

Range("A1").Font.Size=3

Sutun genişliği;

Columns("A:A").ColumnWidth= 35

Otomatik Satır yüksekliği, Tüm satırlar karaktere göre daralır.

Rows.Autofit
Columns.Autofit

Denemedim.Ancak fikir vermek için aklıma gelenler.Selamlar.

 

[baydeniro]

Sayın mrttrn katkılarınız için çok teşekkürler. Bu konuda benim aklıma başka bir fikir geldi. Vaktiniz varsa "Verileri Yukari Kaydirma" isimli konuya bakmanızı rica ederim.

Konuyu Print Alanı olarak gündeme getirmemin nedeni; acaba Bu konu yeni sayfa eklemeden veya mevcuy sayfa değişmeden sadece Print Preview olarak düzenlenip, buna uygun olarak ta çıktı alınabilimiydi !!!! ama anladığım kadarıyla bu mümkün değil.