Makro ile yazdırma.

[hertem]

Merhaba,

Bordro sekmesinde 8 sayfalık bir bordro mevcut 1. sayfa b6 hücresiyle başlıyor
2. sayfa b52, 3. sayfa b98, 4. sayfa b144, 5.sayfa b190, 6. sayfa b236, 7. sayfa b282 ve 8.sayfa b328. yapmak istediğim eğer b328 hücresi dolu ise 8 sayfa bordrodan 2' şer nüsha, eğer b282 hücresi dolu ise 7 sayfa bordrodan 2 şer nüsha olacak şekilde 1 nci sayfaya kadar gidecek makro yazmam gerekiyor.
yardımcı olabilir misiniz?

 

[mancubus]

bu hücreleri sırası ile seçerek
sayfa yapısı / kesmeler / sayfa sonu ekle
işlemleri ile makroya ihtiyaç duymadan yazdırılacak sayfa yapısını belirlemiş olursunuz.

 

[hertem]

Mancubus, bordrolar sekmesinde 8 sayfa bordro mevcut her bir bordo sayfası 25 kişilik veri alıyor. kullanıcılar eğer 26 kişi girdi ise 2 sayfa bordrodan 2 şer nüsha 51 kişi girdi ise 3 sayfa bordrodan 2 şer nüsha olacak şekilde çıktı almalarını istiyorum ve bunu yazdır tuşuna basarak bir kerede yapmalarını istiyorum.

 

[Saban Sertkaya]

Aşağıdaki şekilde bir deneyiniz.

Sub Yazdır()
'Eğer B328 hücresi boş değilse
If Range("B328") <> "" Then
'Sayfa1'den Sayfa8'e kadar 2 nüsha yazdır
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=8, Copies:=2, Collate:=True, IgnorePrintAreas:=False
Exit Sub
ElseIf Range("B282") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=7, Copies:=2, Collate:=True, IgnorePrintAreas:=False
Exit Sub
ElseIf Range("B236") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=6, Copies:=2, Collate:=True, IgnorePrintAreas:=False
Exit Sub
ElseIf Range("B190") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=5, Copies:=2, Collate:=True, IgnorePrintAreas:=False
Exit Sub
ElseIf Range("B144") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=4, Copies:=2, Collate:=True, IgnorePrintAreas:=False
Exit Sub
ElseIf Range("B98") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=3, Copies:=2, Collate:=True, IgnorePrintAreas:=False
Exit Sub
ElseIf Range("B52") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=2, Copies:=2, Collate:=True, IgnorePrintAreas:=False
Exit Sub
ElseIf Range("B6") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=2, Collate:=True, IgnorePrintAreas:=False
End If
End Sub

 

[hertem]

Aşağıdaki şekilde bir deneyiniz.

Sub Yazdır()
'Eğer B328 hücresi boş değilse
If Range("B328") <> "" Then
'Sayfa1'den Sayfa8'e kadar 2 nüsha yazdır
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=8, Copies:=2, Collate:=True, IgnorePrintAreas:=False
Exit Sub
ElseIf Range("B282") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=7, Copies:=2, Collate:=True, IgnorePrintAreas:=False
Exit Sub
ElseIf Range("B236") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=6, Copies:=2, Collate:=True, IgnorePrintAreas:=False
Exit Sub
ElseIf Range("B190") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=5, Copies:=2, Collate:=True, IgnorePrintAreas:=False
Exit Sub
ElseIf Range("B144") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=4, Copies:=2, Collate:=True, IgnorePrintAreas:=False
Exit Sub
ElseIf Range("B98") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=3, Copies:=2, Collate:=True, IgnorePrintAreas:=False
Exit Sub
ElseIf Range("B52") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=2, Copies:=2, Collate:=True, IgnorePrintAreas:=False
Exit Sub
ElseIf Range("B6") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=2, Collate:=True, IgnorePrintAreas:=False
End If
End Sub

Saban bey ilginiz için çok teşekkür ediyorum.