listedeki veri kadar şablon oluşturma ve veri yerleştirme

[imyourfate]

Değerli arkadaşlarım hocalarım
Ekli dosyada görebileceğiniz gibi bir A4 kağıda yerleştirilmiş 4 adet şablon
mevcuttur sorunum şudur ki sayfa1 deki verilerin herbir satırının sayfa2 deki bir şablona rakamların uygun geldiği yerlere yerleştirilmesi ben bunu formülle yapıyorum ama bu işlem her gün yeni liste(sayfa1) ile yapılmak zorunda sayı değişimi söz konusu bu örnekte 35 muhasebe fişi oluşturmak gerekiyor ama bir başka gün bu sayı 20 veya 100 olabilir şablonları yazıcıdan yazdırmam gerekeceği için bir makro kullanarak liste deki total rooms adedi kadar
şablon oluşturmak gerekecek ve tabiki gereken dataların doğru yerlere yerleştirmek olursa makro bir buton ile çalışabilir


Saygılarımla

 

[Emir Hüseyin Çoban]

. . .

Sub kod_bir()
Application.ScreenUpdating = False
aa = Sayfa1.[a65536].End(3).Row - 1

Sayfa2.Range("C7:E10").ClearContents
Sayfa2.Range("I7:J10").ClearContents
Sayfa2.Range("N7:P10").ClearContents
Sayfa2.Range("T7:U10").ClearContents
Sayfa2.Range("C30:E33").ClearContents
Sayfa2.Range("I30:J33").ClearContents
Sayfa2.Range("N30:P33").ClearContents
Sayfa2.Range("T30:U33").ClearContents

For i = 3 To aa Step 4

Sayfa2.Cells(7, "c") = Sayfa1.Cells(i, "a")
Sayfa2.Cells(7, "e") = Sayfa1.Cells(i, "b")
Sayfa2.Cells(8, "c") = Sayfa1.Cells(i, "h")
Sayfa2.Cells(7, "ı") = Sayfa1.Cells(i, "ı")
Sayfa2.Cells(8, "ı") = Sayfa1.Cells(i, "k")
Sayfa2.Cells(9, "ı") = Sayfa1.Cells(i, "l")
Sayfa2.Cells(9, "c") = Sayfa1.Cells(i, "o")

Sayfa2.Cells(30, "c") = Sayfa1.Cells(i + 1, "a")
Sayfa2.Cells(30, "e") = Sayfa1.Cells(i + 1, "b")
Sayfa2.Cells(31, "c") = Sayfa1.Cells(i + 1, "h")
Sayfa2.Cells(30, "ı") = Sayfa1.Cells(i + 1, "ı")
Sayfa2.Cells(31, "ı") = Sayfa1.Cells(i + 1, "k")
Sayfa2.Cells(32, "ı") = Sayfa1.Cells(i + 1, "l")
Sayfa2.Cells(32, "c") = Sayfa1.Cells(i + 1, "o")

Sayfa2.Cells(7, "n") = Sayfa1.Cells(i + 2, "a")
Sayfa2.Cells(7, "p") = Sayfa1.Cells(i + 2, "b")
Sayfa2.Cells(8, "n") = Sayfa1.Cells(i + 2, "h")
Sayfa2.Cells(7, "t") = Sayfa1.Cells(i + 2, "ı")
Sayfa2.Cells(8, "t") = Sayfa1.Cells(i + 2, "k")
Sayfa2.Cells(9, "t") = Sayfa1.Cells(i + 2, "l")
Sayfa2.Cells(9, "n") = Sayfa1.Cells(i + 2, "o")

Sayfa2.Cells(30, "n") = Sayfa1.Cells(i + 3, "a")
Sayfa2.Cells(30, "p") = Sayfa1.Cells(i + 3, "b")
Sayfa2.Cells(31, "n") = Sayfa1.Cells(i + 3, "h")
Sayfa2.Cells(30, "t") = Sayfa1.Cells(i + 3, "ı")
Sayfa2.Cells(31, "t") = Sayfa1.Cells(i + 3, "k")
Sayfa2.Cells(32, "t") = Sayfa1.Cells(i + 3, "l")
Sayfa2.Cells(32, "n") = Sayfa1.Cells(i + 3, "o")

Sayfa2.Range("a1:u45").PrintOut
Next i

Application.ScreenUpdating = True
MsgBox " B İ T T İ "
End Sub

. . .

 

[imyourfate]

hocam eline emeğine sağlık ama tam olarak çalışmadı satır adedi kadar şablon oluşturup doldurmuyor bazılarında içeriğide doldurmamış

 

[Emir Hüseyin Çoban]

. . .

Merhaba.

Her 4 satır için 1 sayfa mı yazdıracak ?
Yoksa her satır için, 1 sayfamı yazdıracak ?

Muhasebe fişlerini ayrı sayfa olarak tutması gerekiyor mu?
Direk yazdırsak olmaz mı ?

. . .

 

[imyourfate]

hocam her 4 satır bir sayfa olacak print out direkt makroda olmasına gerek yok onu ben ayrıca yazdırırım önemli olan her sayfada 4 muhasebe fişi olucak
ama dediğim gibi liste bir uzayıp bir kısalıyor

 

[Emir Hüseyin Çoban]

. . .

Kodlamayı bu şekilde yaptım zaten.

4 satırı sayfa2 yerleştirir ve yazdırır. Bu şekilde son satıra kadar gider.
Sayfa1 deki listenin uzayıp kısalması önemli değil, sadece süreyi değiştirir.

Sizin tek tek yazdırmanız için her 4 satır için 1 sayfa eklememiz gerekir.

. . .

 

[imyourfate]

evde yazıcı yok ben düşündümki önce şablonları oluşturup sonra yazdırıyor
her sayfadan sonra yazdırıp diğer sayfayımı oluşturuyor?

 

[Emir Hüseyin Çoban]

. . .

Yazıcı ile bir deneyin. Hatalı bir işlem varsa kontrol edelim.
Kodlar 4 satırı şablona yerleştirir ve yazdırır. Sonra sıradaki 4 satırı yerleştirip, yazdırır.
Bu şekilde son satıra kadar devam eder.

. . .

 

[imyourfate]

hocam elinize sağlık deneyip foruma tekrar yazarım ama bazı isimleri almıyor gibi tekrar bakma şansınız varmı buton ekledim kafama takılan hücreleri kırmızı yaptım

 

[imyourfate]

dosyayı şimdi ekledim

 

[Emir Hüseyin Çoban]

. . .

Müşteri İsmi kısmını düzelttim. Yukarıdaki kodları güncelledim.
Sayfa1 son satırda Total bilgileri olduğu için son fişe bu bilgileri yazdırıyor.

Kodlar ile Total bilgilerini sildirirsek, düzelecektir.

. . .

 

[fireman64]

Başlıkları ve total bölümünü silerek bunu kullanabilirsin Hüseyin hocamın kodlarıdır.

 

[imyourfate]

tamam şimdi gördüm dosyayı elinize emeğinize sağlık on numara çalışma olmuş Allah razı olsun