Çoklu sayfa(form) yazdırma yardımı lütfen

[lock&sawyer]

Sevgili arkadaşlar,

Çalıştıgım şantiyede işler bitme aşamasında, dolayısıyla yoğun bir şekilde işçi çıkışı var toplamda 4-5 bin kişinin çalıştığını soylersem yogunlugu anlarsınız.
İşten ayrılanlar için duzenlediğim 3 ayrı form var. Örnektede görülecegi üzere düşeyara formülüyle bu formları dolduruyordum ve tek tek çıkış alıyorum. Şimdiye kadar gunde 5-10 kişi cıktıgı için bu fazla sorun olmuyordu ama şimdi işbitimi nedeniyle çıkışlar o kadar çoğaldıki günde 100-150 kişiye ulaştı ve dahada artacak. bunlarıda tek tek print etmek inanılmaz zaman alıyor.
Benim isteğim örnekteki veri sayfasına doneleri yazdıktan sonra formların tek tıklamayla print edilmesi. yani 50 kişilik çıkış bilgisini yazdığımda hepsinin formlarını aynı anda print edebilmek. Bu konuda yardımlarınıza bekliyorum.

Örnek ekte olup,siz değerli üstadlardan beni bu zorluktan kurtarmanızı rica ediyorum.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub İŞTEN_ÇIKIŞLARI_SIRAYLA_YAZDIR()
    Dim X As Long
 
    If WorksheetFunction.CountA(Sheets("VERI").Range("B2:B65536")) = 0 Then
        MsgBox "Yazdırılacak veri girişi bulunamadı !", vbCritical
        Exit Sub
    End If
 
    For X = 2 To Sheets("VERI").Range("B65536").End(3).Row
        If Sheets("VERI").Cells(X, 2) <> Empty Then
        Sheets("İŞTEN AYRILMA FORMU").Range("N4") = Sheets("VERI").Cells(X, 2)
        Sheets("İŞTEN AYRILMA FORMU").PrintOut
        Sheets("SICIL DEGER. FORMU ").PrintOut
        Sheets("CALISMA BELGESI ").PrintOut
        End If
    Next
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[lock&sawyer]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub İŞTEN_ÇIKIŞLARI_SIRAYLA_YAZDIR()
    Dim X As Long
 
    If WorksheetFunction.CountA(Sheets("VERI").Range("B2:B65536")) = 0 Then
        MsgBox "Yazdırılacak veri girişi bulunamadı !", vbCritical
        Exit Sub
    End If
 
    For X = 2 To Sheets("VERI").Range("B65536").End(3).Row
        If Sheets("VERI").Cells(X, 2) <> Empty Then
        Sheets("İŞTEN AYRILMA FORMU").Range("N4") = Sheets("VERI").Cells(X, 2)
        Sheets("İŞTEN AYRILMA FORMU").PrintOut
        Sheets("SICIL DEGER. FORMU ").PrintOut
        Sheets("CALISMA BELGESI ").PrintOut
        End If
    Next
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Üstad bilgine emeğine saglık..

Tam istediğim gibi oldu. Teşekkur edrim.

 

[lock&sawyer]

Kusura bakmayın neden oldu bilmiyorum ama aynı mesaj tekrar tekrar yazıldı.

 

[Korhan Ayhan]

Selamlar,

Fazla mesajlar taşınmıştır.

 

[lock&sawyer]

Hocam kod çok işime yaracak.Ama bir sorun varç kodu girdikten sonra çalışmamı yapıyorum ama dosyayı kapatıp actıktan sonra kod silinmiş oluyo, her actığımda yeniden girmem gerekiyor.kaydetmeye öalıştığımda aşağıdaki resimdeki hatayı veriyor.Ne yaptıysam olmadı. Ne yapmam gerekiyor acaba.

 

[Korhan Ayhan]

Selamlar,

Eklediğiniz resim görünmüyor. Fakat anladığım kadarıyla siz 2007 excel versiyonu kullanıyorsunuz. Dosyanızı kaydederken dosya türü seçeneklerinde "Makro İçeren Dosya" gibi bir seçenek olmalı. Siz onu seçip dosyanızı kaydetmeyi deneyin.

 

[lock&sawyer]

Selamlar,

Eklediğiniz resim görünmüyor. Fakat anladığım kadarıyla siz 2007 excel versiyonu kullanıyorsunuz. Dosyanızı kaydederken dosya türü seçeneklerinde "Makro İçeren Dosya" gibi bir seçenek olmalı. Siz onu seçip dosyanızı kaydetmeyi deneyin.

İlginize teşekkur ederim hocam evet haklısınız dediğiniz gibi yapınca oldu.
Evet yeni 2007 eng. versiyonuna geçtik. Zaten hata notunda yazıyormuş dediğinizi yapmam gerektiği. Daha şimdi farkına vardım.Çok teşekkurler.