Yazıcıya gönderme ve kopya sayısı

[cebelitarık]

Forumun değerli Üyeleri
Aşağıya örneğini koyduğum dosyada ayrınlı olarak açıklama yaptım.
Formun belli kriterlere göre yazıcıdan çıktısını almam gerekiyor.
İlgilenecek arkadaşlara şimdiden teşekkür ederim.
Saygılarımla

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub YAZDIR()
    Dim X As Long, Y As Long
    
    Sheets("LİSTE").Select
    
    If Sheets("LİSTE").Range("L13") = Empty Then
        MsgBox "İlk sıra no boş !" & Chr(10) & "Lütfen kontrol ediniz.", vbCritical
        Exit Sub
    End If
    
    If Sheets("LİSTE").Range("L16") = Empty Then
        MsgBox "Son sıra no boş !" & Chr(10) & "Lütfen kontrol ediniz.", vbCritical
        Exit Sub
    End If
    
    If Sheets("LİSTE").Range("L19") = Empty Then
        MsgBox "Kopya sayısı bölümü boş !" & Chr(10) & "Lütfen kontrol ediniz.", vbCritical
        Exit Sub
    End If
    
    If Sheets("LİSTE").CheckBox1 = True And Sheets("LİSTE").CheckBox2 = False Then
        For X = Sheets("LİSTE").Range("L13") To Sheets("LİSTE").Range("L16")
            If Sheets("LİSTE").Range("L13") > Sheets("LİSTE").Range("L16") Then
                MsgBox "İlk sıra numarası, son sıra numarasından büyük olamaz!", vbCritical
            Exit Sub
            Else
                For Y = 2 To Sheets("VERİLER").Range("I65536").End(3).Row
                    If Sheets("VERİLER").Cells(Y, "A") = X Then
                    If Sheets("VERİLER").Cells(Y, "I") = 1 Then
                        Sheets("LİSTE").Range("G5") = Sheets("VERİLER").Cells(Y, "C")
                        Sheets("LİSTE").Range("E12") = Sheets("VERİLER").Cells(Y, "L")
                        Sheets("LİSTE").Range("E14") = Sheets("VERİLER").Cells(Y, "N")
                        Sheets("LİSTE").Range("E15") = Sheets("VERİLER").Cells(Y, "O")
                        Sheets("LİSTE").Range("E16") = Sheets("VERİLER").Cells(Y, "P") & " " & Sheets("VERİLER").Cells(Y, "Q")
                        Sheets("LİSTE").Range("E20") = Sheets("VERİLER").Cells(Y, "G")
                        Sheets("LİSTE").Range("E21") = Sheets("VERİLER").Cells(Y, "D")
                        Sheets("LİSTE").Range("E22") = Sheets("VERİLER").Cells(Y, "J") & " " & Sheets("VERİLER").Cells(Y, "K")
                        Sheets("LİSTE").Range("E23") = Sheets("VERİLER").Cells(Y, "R")
                        Sheets("LİSTE").Range("E24") = Sheets("VERİLER").Cells(Y, "M")
                        Sheets("LİSTE").Range("E25") = Sheets("VERİLER").Cells(Y, "B")
                        Sheets("LİSTE").PrintOut Copies:=Sheets("LİSTE").Range("L19")
                    End If
                    End If
                Next
            End If
        Next
        
    ElseIf Sheets("LİSTE").CheckBox1 = False And Sheets("LİSTE").CheckBox2 = True Then
        For X = Sheets("LİSTE").Range("L13") To Sheets("LİSTE").Range("L16")
            If Sheets("LİSTE").Range("L13") > Sheets("LİSTE").Range("L16") Then
                MsgBox "İlk sıra numarası, son sıra numarasından büyük olamaz!", vbCritical
            Exit Sub
            Else
                For Y = 2 To Sheets("VERİLER").Range("I65536").End(3).Row
                    If Sheets("VERİLER").Cells(Y, "A") = X Then
                    If Sheets("VERİLER").Cells(Y, "I") <> 1 Then
                        Sheets("LİSTE").Range("G5") = Sheets("VERİLER").Cells(Y, "C")
                        Sheets("LİSTE").Range("E12") = Sheets("VERİLER").Cells(Y, "L")
                        Sheets("LİSTE").Range("E14") = Sheets("VERİLER").Cells(Y, "N")
                        Sheets("LİSTE").Range("E15") = Sheets("VERİLER").Cells(Y, "O")
                        Sheets("LİSTE").Range("E16") = Sheets("VERİLER").Cells(Y, "P") & " " & Sheets("VERİLER").Cells(Y, "Q")
                        Sheets("LİSTE").Range("E20") = Sheets("VERİLER").Cells(Y, "G")
                        Sheets("LİSTE").Range("E21") = Sheets("VERİLER").Cells(Y, "D")
                        Sheets("LİSTE").Range("E22") = Sheets("VERİLER").Cells(Y, "J") & " " & Sheets("VERİLER").Cells(Y, "K")
                        Sheets("LİSTE").Range("E23") = Sheets("VERİLER").Cells(Y, "R")
                        Sheets("LİSTE").Range("E24") = Sheets("VERİLER").Cells(Y, "M")
                        Sheets("LİSTE").Range("E25") = Sheets("VERİLER").Cells(Y, "B")
                        Sheets("LİSTE").PrintOut Copies:=Sheets("LİSTE").Range("L19")
                    End If
                    End If
                Next
            End If
        Next
        
    ElseIf Sheets("LİSTE").CheckBox1 = True And Sheets("LİSTE").CheckBox2 = True Then
        For X = Sheets("LİSTE").Range("L13") To Sheets("LİSTE").Range("L16")
            If Sheets("LİSTE").Range("L13") > Sheets("LİSTE").Range("L16") Then
                MsgBox "İlk sıra numarası, son sıra numarasından büyük olamaz!", vbCritical
            Exit Sub
            Else
                For Y = 2 To Sheets("VERİLER").Range("I65536").End(3).Row
                    If Sheets("VERİLER").Cells(Y, "A") = X Then
                        Sheets("LİSTE").Range("G5") = Sheets("VERİLER").Cells(Y, "C")
                        Sheets("LİSTE").Range("E12") = Sheets("VERİLER").Cells(Y, "L")
                        Sheets("LİSTE").Range("E14") = Sheets("VERİLER").Cells(Y, "N")
                        Sheets("LİSTE").Range("E15") = Sheets("VERİLER").Cells(Y, "O")
                        Sheets("LİSTE").Range("E16") = Sheets("VERİLER").Cells(Y, "P") & " " & Sheets("VERİLER").Cells(Y, "Q")
                        Sheets("LİSTE").Range("E20") = Sheets("VERİLER").Cells(Y, "G")
                        Sheets("LİSTE").Range("E21") = Sheets("VERİLER").Cells(Y, "D")
                        Sheets("LİSTE").Range("E22") = Sheets("VERİLER").Cells(Y, "J") & " " & Sheets("VERİLER").Cells(Y, "K")
                        Sheets("LİSTE").Range("E23") = Sheets("VERİLER").Cells(Y, "R")
                        Sheets("LİSTE").Range("E24") = Sheets("VERİLER").Cells(Y, "M")
                        Sheets("LİSTE").Range("E25") = Sheets("VERİLER").Cells(Y, "B")
                        Sheets("LİSTE").PrintOut Copies:=Sheets("LİSTE").Range("L19")
                    End If
                Next
            End If
        Next
    End If
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[cebelitarık]

Sayın Korhan Ayhan
İlginize ve emeğinize çok teşekkür ederim.
Tam istediğim gibi olmuş.
Sadece "Sıra no son" olan değeri yazdırmıyor. Yani L16 daki değere karşılık gelen satırı yazdırmıyor.
Birde Y döngüsünü de ilk ve son değerle sınırladım.
Böylece döngü tüm dolu satırları dolaşmıyor.

For Y = Sheets("LİSTE").Range("L13") To Sheets("LİSTE").Range("L16")

Saygılarımla