Sertifika Yazdırma

[ckarabacak]

Arkadaşlar Merhaba

Ekli dosyada toplu yazdırma makrosunda düzenleme yapılarak liste sayfasındaki çıkış tarihi olanları yazdırmak istemiyorum.

Yardımlarınızı rica ederim.

 

[Ömer]

Merhaba,

Deneyiniz. İf satırı ilave edilmiştir.

Sub SERTİFİKA_YAZDIR()
    Dim X As Long

    If WorksheetFunction.CountA(Sheets("LİSTE").Range("B3:B65000")) = 0 Then
        MsgBox "Yazdırılacak veri girişi bulunamadı !", vbCritical
        Exit Sub
    End If

    For X = 3 To Sheets("LİSTE").Range("B65000").End(3).Row
        If Sheets("LİSTE").Cells(X, 3) <> Empty Then
            If Sheets("LİSTE").Cells(X, 6) = "" Then 'ilave
                Sheets("SERTİFİKA").Range("G2") = Sheets("LİSTE").Cells(X, 2)
                Sheets("SERTİFİKA").PrintOut
            End If 'ilave
        End If
    Next

    MsgBox "YAZDIRMA BİTMİŞTİR.", vbInformation
End Sub

 

[ckarabacak]

Ömer Bey Merhaba

İlginize Teşekkür ederim. Makro ilavesi kısmen çalışıyor yani ekranda tamam penceresi oluşuyor ve her kişi için tamam butonuna basılması gerekiyor
Toplu yazdır butonuna basıldığında çıkış tarihi haricindekilerini yazıcıya toplu göndermesini istiyorum

 

[Ömer]

Mesajı kontrol için koymuştum, silmeyi atlamışım.
Kodları düzelttim tekrar deneyiniz.

 

[ckarabacak]

Ömer Bey Çok Teşekkür ederim.

Sorun çözüldü İyi günler iyi çalışmalar dilerim.

 

[ckarabacak]

Ömer Bey Tekrar Merhaba

Yazılım Makrosunda ilgili ay dan önceki aya ait çıkışı olanları yazmaması opsiyonu olabilir mi?

 

[Ömer]

Sorunuzu anlayamadım. Daha detaylı açıklayınız. Ayrıca ilgili aydan kastınız, günü tarihindeki ay mı?

 

[ckarabacak]

İçinde bulunduğumuz ay

 

[Ömer]

İstediğiniz bu mu?

Sub SERTİFİKA_YAZDIR()
    Dim X As Long

    If WorksheetFunction.CountA(Sheets("LİSTE").Range("B3:B65000")) = 0 Then
        MsgBox "Yazdırılacak veri girişi bulunamadı !", vbCritical
        Exit Sub
    End If

    For X = 3 To Sheets("LİSTE").Range("B65000").End(3).Row
        If Sheets("LİSTE").Cells(X, 3) <> Empty Then
            If Sheets("LİSTE").Cells(X, 6) <> "" Then
                If Sheets("LİSTE").Cells(X, 6) < DateSerial(Year(Date), Month(Date), 1) Then
                    Sheets("SERTİFİKA").Range("G2") = Sheets("LİSTE").Cells(X, 2)
                    Sheets("SERTİFİKA").PrintOut
                End If
            End If
        End If
    Next

    MsgBox "YAZDIRMA BİTMİŞTİR.", vbInformation
End Sub

 

[ckarabacak]

Ömer Bey Günaydın

Hata veriyor dosya ektedir.

 

[Ömer]

Hata almadım, sadece öncesi yazılacak olarak algıladığım için < işareti koymuştum.

If Sheets("LİSTE").Cells(X, 6) < DateSerial(Year(Date), Month(Date), 1) Then

Yerine;

If Sheets("LİSTE").Cells(X, 6) >= DateSerial(Year(Date), Month(Date), 1) Then

Yazarak deneyiniz.

 

[ckarabacak]

Ömer Bey Merhaba

Her iki seçeneği denedim hata veriyor. <'te 3.kişide takılı kalıyor. >= 5.ci kişide takılı kalıyor.

Liste sayfasında açıklamadaki gibi sadece 3. cü satırdaki kişi yazılmayacak diğer kişilerin tamamı yazılacak.
Dosyayı ektedir. Sizde denermisiniz lütfen dosya üzerinde

 

[Ömer]

Deneyiniz.

Sub SERTİFİKA_YAZDIR()
    Dim X As Long

    If WorksheetFunction.CountA(Sheets("LİSTE").Range("B3:B65000")) = 0 Then
        MsgBox "Yazdırılacak veri girişi bulunamadı !", vbCritical
        Exit Sub
    End If

    For X = 3 To Sheets("LİSTE").Range("B65000").End(3).Row
        If Sheets("LİSTE").Cells(X, 3) <> Empty Then
            If Sheets("LİSTE").Cells(X, 6) = "" Then
                Sheets("SERTİFİKA").Range("G2") = Sheets("LİSTE").Cells(X, 2)
                Sheets("SERTİFİKA").PrintOut
            Else
                If Sheets("LİSTE").Cells(X, 6) >= DateSerial(Year(Date), Month(Date), 1) Then
                    Sheets("SERTİFİKA").Range("G2") = Sheets("LİSTE").Cells(X, 2)
                    Sheets("SERTİFİKA").PrintOut
                End If
            End If
        End If
    Next

    MsgBox "YAZDIRMA BİTMİŞTİR.", vbInformation
End Sub

 

[ckarabacak]

Ömer Bey Tekrar Merhaba

İşlem tamam elinize, emeğinize sağlık
Teşekkür ederim

 

[Ömer]

Rica ederim. Kodda küçük bir değişiklik yapmıştım. Geç kalmış olabilirim. Siz yine de son mesajdaki kodu tekrar kopyalayıp deneyiniz.