Toplu yazdırma

[mkuru28]

Arkadaşlar herkese kolay gelsin.
Ekli çalışma kitabında detaylı olarak tarif ettiğim gibi başka bir saydadan Düşeyara formülü ile alınan personel bilgilerinin Form sayfasında toplu olarak yazdırılabilmesi mümkün müdür.

Toplu_yazdir

 

[necati]

Merhaba, toplu yazdırma için kod:
Ad yöneticisindeki "personel" tanımının kodunu şu şekilde değiştirirseniz sondaki boş satırları veri doğrulama içinde gereksiz yere göstermez.
=KAYDIR(DATA!$B$5;0;0;BAĞ_DEĞ_DOLU_SAY(DATA!$B$5:$B$35);1)

Sub yaz()
Dim dv As Validation
Dim vaSplit As Variant
Dim i As Long, Evet As String

Sayfa2.Activate
Sayfa2.Range("c5").Select
Set dv = Sayfa2.Range("c5").Validation
vaSplit = Range(dv.Formula1).Value

For i = LBound(vaSplit, 1) To UBound(vaSplit, 1)
    If vaSplit(i, 1) = ActiveCell.Value Then
        If i < UBound(vaSplit, 1) Then
            ActiveCell.Value = vaSplit(i + 1, 1)
        Else
            ActiveCell.Value = vaSplit(1, 1)
        End If
    End If
    
    Evet = Application.WorksheetFunction.VLookup(ActiveCell.Value, Sayfa1.Range("b5:g35"), 6, False)
    
    If Evet = "EVET" Then
        ActiveSheet.PrintOut
    End If

Next i

MsgBox "Yazdırma işlemi bitti", vbInformation

End Sub

 

[mkuru28]

Hocam şimdi deneme şansım oldu. Veri doğrulamada hangi personelin ismi seçili ise personel sayısı kadar o kişinin formunu yazdırıyor.

 

[necati]

Deneyerek yazmıştım, bir problem göremedim.
Sayfayı ve VBA ekranını yan yana getirin. Adımlamayı (F8) kullanarak satır satır ilerleyince
ActiveCell.Value = vaSplit(i + 1, 1)
satırını geçerken sonraki personel bilgisi gelmesi lazım. Bunu bir kontrol edebilir misiniz gerçekleşiyor mu?

 

[mkuru28]

Hocam çok teşekkür ederim. Şimdi yazdırdı ama

Evet = Application.WorksheetFunction.VLookup(ActiveCell.Value, Sayfa1.Range("b5:g10"), 6, False)

satırında

Run Time error '1004':
Worksheet Function sınıfının VLookup özelliği alınamıyor

hatası veriyor.

 

[necati]

Sayfa isimlerini düzeltiniz. Eklediğiniz örneğe göre Sayfa1=DATA eşleşmesi var. Sizin orijinal dosyanızdaki sayfa ismi VBA'da ne ise onu yazınız.

 

[necati]

Bunu kullanın sayfa isimleri en başta set edildi, bir karışıklık olmaz, daha kullanışlı.

Sub yaz()
Dim dv As Validation
Dim vaSplit As Variant
Dim i As Long, Evet As String

Set s1 = ThisWorkbook.Worksheets("DATA")
Set s2 = ThisWorkbook.Worksheets("FORM")
s2.Activate
s2.Range("c5").Select
Set dv = s2.Range("c5").Validation
vaSplit = Range(dv.Formula1).Value

For i = LBound(vaSplit, 1) To UBound(vaSplit, 1)
    If vaSplit(i, 1) = ActiveCell.Value Then
        If i < UBound(vaSplit, 1) Then
            ActiveCell.Value = vaSplit(i + 1, 1)
        Else
            ActiveCell.Value = vaSplit(1, 1)
        End If
    End If
    
    Evet = Application.WorksheetFunction.VLookup(ActiveCell.Value, s1.Range("b5:g35"), 6, False)
    
    If Evet = "EVET" Then
        s2.PrintOut
    End If

Next i

MsgBox "Yazdırma işlemi bitti", vbInformation

End Sub

 

[mkuru28]

Hocam en son verdiğiniz kod gayet güzel çalışıyor. Ama

Evet = Application.WorksheetFunction.VLookup(ActiveCell.Value, s1.Range("B5:E20"), 4, False)

Bu kısımda yine aynı hatayı veriyor. Normal EVET seçili olan personelleri yazdırıyor ama bu uyarıyı vermeye devam ediyor. Ve "Yazdırma işlemi bitti" yazan mesaj kısmı açılmıyor.

 

[necati]

Düşeyara formülünde bakılacak sütun verdiğiniz örnekte 6 idi, 4 olarak ayarlamışsınız. Bundan emin misiniz?

 

[mkuru28]

Hocam kodu başka bir çalışma kitabına uyarladım. Orada B5:E20 aralığı var ve Evet Hayır yazan kısım E sütununda olduğu için kendi çalışmama göre değiştirerek uyarladım. Fakat örnek çalışma kitabında da denedim aynı şekilde hata veriyor. Ancak yazdırma işlemini sorunsuz bir şekilde tamamlıyor. Olmazsa bu şekilde de kullanabilirim. Zaman ayırıp emek verdiğiniz için çok teşekkür ediyorum.

 

[necati]

Rica ederim, kolay gelsin.

 

[mkuru28]

Hocam sorun çözüldü ama sitede hata mesajlarını inceleyerek ufak bir değişiklik yapınca sorunu çözdüm ve bilgi amaçlı olarak paylaşmak istedim. Kodun bu kısmını

Evet = Application.WorksheetFunction.VLookup(ActiveCell.Value, Sayfa1.Range("b5:g10"), 6, False)

Bu şekilde değiştirince hata ortadan kalkıyor.

Evet = Application.VLookup(ActiveCell.Value, Sayfa1.Range("b5:g10"), 6, False)