su makbuzu

[zfr10]

Selam arkadaşlar sizlerin desteğiyle hazırlamış olduğum su makbuzu programıyla ilgili olarak şöyle bir şey yapmak istiyorum.
Makbuz sayfasına giriş sayfasından gereken bilgileri alıp verileri yaz butonuna tıkladığım zaman giriş sayfasındaki verileri alıp makbuz sayfasında olduğu gibi üçerli olarak otomatik yazdırmak yazdırmak istiyorum.Fakat giriş sayfasında olan F5 ile F280 arasında boş olanların yazılmamasını istiyorum.Yardımlarınızı bekliyorum.
Saygılar...

 

[halit3]

Selam arkadaşlar sizlerin desteğiyle hazırlamış olduğum su makbuzu programıyla ilgili olarak şöyle bir şey yapmak istiyorum.
Makbuz sayfasına giriş sayfasından gereken bilgileri alıp verileri yaz butonuna tıkladığım zaman giriş sayfasındaki verileri alıp makbuz sayfasında olduğu gibi üçerli olarak otomatik yazdırmak yazdırmak istiyorum.Fakat giriş sayfasında olan F5 ile F280 arasında boş olanların yazılmamasını istiyorum.Yardımlarınızı bekliyorum.
Saygılar...

Daha önce bu kodu yazdığımı hatırlıyorum,

Sub Düğme1_Tıklat()
Dim sat
sat = 1
sat1 = 0
sat2 = 0
sat3 = 0
For r = 5 To Worksheets("GİRİŞ").Cells(Rows.Count, "B").End(3).Row
If Sheets("GİRİŞ").Cells(r, "f").Value > 0 Then
If sat = 1 Then
sat1 = r
Sheets("MAKBUZ").Cells(2, "f").Value = Sheets("GİRİŞ").Cells(sat1, "b").Value
Sheets("MAKBUZ").Cells(3, "f").Value = Sheets("GİRİŞ").Cells(sat1, "a").Value
Sheets("MAKBUZ").Cells(4, "f").Value = Sheets("GİRİŞ").Cells(sat1, "c").Value
Sheets("MAKBUZ").Cells(7, "a").Value = Sheets("GİRİŞ").Cells(sat1, "d").Value
Sheets("MAKBUZ").Cells(7, "b").Value = Sheets("GİRİŞ").Cells(sat1, "e").Value
Sheets("MAKBUZ").Cells(9, "c").Value = Sheets("GİRİŞ").Cells(sat1, "f").Value
End If
If sat = 2 Then
sat2 = r
Sheets("MAKBUZ").Cells(13, "f").Value = Sheets("GİRİŞ").Cells(sat2, "b").Value
Sheets("MAKBUZ").Cells(14, "f").Value = Sheets("GİRİŞ").Cells(sat2, "a").Value
Sheets("MAKBUZ").Cells(15, "f").Value = Sheets("GİRİŞ").Cells(sat2, "c").Value
Sheets("MAKBUZ").Cells(18, "a").Value = Sheets("GİRİŞ").Cells(sat2, "d").Value
Sheets("MAKBUZ").Cells(18, "b").Value = Sheets("GİRİŞ").Cells(sat2, "e").Value
Sheets("MAKBUZ").Cells(20, "c").Value = Sheets("GİRİŞ").Cells(sat2, "f").Value
End If
If sat = 3 Then
sat3 = r
Sheets("MAKBUZ").Cells(24, "f").Value = Sheets("GİRİŞ").Cells(sat3, "b").Value
Sheets("MAKBUZ").Cells(25, "f").Value = Sheets("GİRİŞ").Cells(sat3, "a").Value
Sheets("MAKBUZ").Cells(26, "f").Value = Sheets("GİRİŞ").Cells(sat3, "c").Value
Sheets("MAKBUZ").Cells(29, "a").Value = Sheets("GİRİŞ").Cells(sat3, "d").Value
Sheets("MAKBUZ").Cells(29, "b").Value = Sheets("GİRİŞ").Cells(sat3, "e").Value
Sheets("MAKBUZ").Cells(31, "c").Value = Sheets("GİRİŞ").Cells(sat3, "f").Value
End If
If sat = 3 Then
Sheets("MAKBUZ").PageSetup.PrintArea = "$A$1:$H$33"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
'Exit Sub
sat = 0
End If
sat = sat + 1
End If
Next r
If sat < 3 Then
Sheets("MAKBUZ").PageSetup.PrintArea = "$A$1:$H$33"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
End Sub

 

[halit3]

Bu kod üçerli guruplar halinde yazdırıyor en sonundaki gurupta ya hata verecektir yada son yazdırdığından bir daha yazdıracaktır.

 

[halit3]

Bu da farklı bir uygulama

Sub Düğme1_Tıklat()
Dim sat
sat = 4
sat1 = 0
sat2 = 0
sat3 = 0
Dim say(65000)
For r = 5 To Worksheets("GİRİŞ").Cells(Rows.Count, "B").End(3).Row
If Sheets("GİRİŞ").Cells(r, "f").Value > 0 Then
sat = sat + 1
say(sat) = r
End If
Next r

say(sat + 1) = r + 1
say(sat + 2) = r + 2

For i = 5 To sat Step 3
sat1 = Val(say(i))
Sheets("MAKBUZ").Cells(2, "f").Value = Sheets("GİRİŞ").Cells(sat1, "b").Value
Sheets("MAKBUZ").Cells(3, "f").Value = Sheets("GİRİŞ").Cells(sat1, "a").Value
Sheets("MAKBUZ").Cells(4, "f").Value = Sheets("GİRİŞ").Cells(sat1, "c").Value
Sheets("MAKBUZ").Cells(7, "a").Value = Sheets("GİRİŞ").Cells(sat1, "d").Value
Sheets("MAKBUZ").Cells(7, "b").Value = Sheets("GİRİŞ").Cells(sat1, "e").Value
Sheets("MAKBUZ").Cells(9, "c").Value = Sheets("GİRİŞ").Cells(sat1, "f").Value
sat2 = Val(say(i + 1))
Sheets("MAKBUZ").Cells(13, "f").Value = Sheets("GİRİŞ").Cells(sat2, "b").Value
Sheets("MAKBUZ").Cells(14, "f").Value = Sheets("GİRİŞ").Cells(sat2, "a").Value
Sheets("MAKBUZ").Cells(15, "f").Value = Sheets("GİRİŞ").Cells(sat2, "c").Value
Sheets("MAKBUZ").Cells(18, "a").Value = Sheets("GİRİŞ").Cells(sat2, "d").Value
Sheets("MAKBUZ").Cells(18, "b").Value = Sheets("GİRİŞ").Cells(sat2, "e").Value
Sheets("MAKBUZ").Cells(20, "c").Value = Sheets("GİRİŞ").Cells(sat2, "f").Value
sat3 = Val(say(i + 2))
Sheets("MAKBUZ").Cells(24, "f").Value = Sheets("GİRİŞ").Cells(sat3, "b").Value
Sheets("MAKBUZ").Cells(25, "f").Value = Sheets("GİRİŞ").Cells(sat3, "a").Value
Sheets("MAKBUZ").Cells(26, "f").Value = Sheets("GİRİŞ").Cells(sat3, "c").Value
Sheets("MAKBUZ").Cells(29, "a").Value = Sheets("GİRİŞ").Cells(sat3, "d").Value
Sheets("MAKBUZ").Cells(29, "b").Value = Sheets("GİRİŞ").Cells(sat3, "e").Value
Sheets("MAKBUZ").Cells(31, "c").Value = Sheets("GİRİŞ").Cells(sat3, "f").Value
Sheets("MAKBUZ").PageSetup.PrintArea = "$A$1:$H$33"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Next i
 
End Sub

 

[zfr10]

Sayın hocam göstermiş olduğunuz alakadan dolayı size minnettarım.Saygılarımı sunar,çok teşekkür ederim.

 

[assenucler]

Sayın halit3;


Üstadım günaydın. Sizi her zaman izleyen bir hayranınız olarak, verdiğiniz katkı için ben de size teşekkür etmek istedim.

İstanbul'dan sevgi ve saygılar.

 

[halit3]

Sayın hocam göstermiş olduğunuz alakadan dolayı size minnettarım.Saygılarımı sunar,çok teşekkür ederim.

Ben kodu yazdığımı neredeyse unutmuştum 12 gün olmuş geri dönüşünüz.
Cevap yazmayı geciktirmemeye özen gösterin.

İyi çalışmalar

 

[halit3]

Sayın halit3;


Üstadım günaydın. Sizi her zaman izleyen bir hayranınız olarak, verdiğiniz katkı için ben de size teşekkür etmek istedim.

İstanbul'dan sevgi ve saygılar.

Teşekkürler iyi çalışmalar

 

[zfr10]

Halit Bey haklısınız fakat işlerin yoğunluğundan dolayı siteye girmeye pek az vaktim oluyor o yüzden cevabı geç yazdım,kusura bakmayın,yine de alakanızdan dolayı teşekkür ederim.Bursa Mustafa Kemal Paşa'dan saygı ve sevgilerimi iletirim.