Private Sub CommandButton2_Click()
Dim spl As Worksheet
On Error Resume Next
yzctemizle
Set spl = Sheets("Liste")
Set yzc = Sheets("Etiket")
ss = spl.Cells(Rows.Count, 2).End(xlUp).Row - 1
If ss < 2 Then MsgBox "Yazdırılacak kayıt bulunamadı.", vbExclamation, "ExcelCozum.com": Exit Sub
Application.DisplayAlerts = False
For n = 1 To ListView1.ListItems.Count
If ListView1.ListItems

.Checked Then
say = say + 1
sat = n + 1
With yzc
If say Mod (2) = 2 Then
yzctemizle
say2 = say2 + 1
.Cells(1, 1).Value = ListView1.ListItems

.ListSubItems(2).Text
.Cells(2, 1).Value = ListView1.ListItems

.ListSubItems(3).Text
Else
.Cells(1, 1).Value = ListView1.ListItems

.ListSubItems(2).Text
.Cells(2, 1).Value = ListView1.ListItems

.ListSubItems(3).Text
.PrintOut ActivePrinter:="Xprinter XP-470B"
End If
spl.Cells(sat, 16).Value = "EVET"
spl.Cells(sat, 2).Font.color = vbRed
spl.Cells(sat, 3).Font.color = vbRed
spl.Cells(sat, 4).Font.color = vbRed
spl.Cells(sat, 5).Font.color = vbRed
spl.Cells(sat, 6).Font.color = vbRed
spl.Cells(sat, 7).Font.color = vbRed
spl.Cells(sat, 8).Font.color = vbRed
spl.Cells(sat, 9).Font.color = vbRed
spl.Cells(sat, 10).Font.color = vbRed
spl.Cells(sat, 11).Font.color = vbRed
spl.Cells(sat, 12).Font.color = vbRed
spl.Cells(sat, 13).Font.color = vbRed
spl.Cells(sat, 14).Font.color = vbRed
spl.Cells(sat, 15).Font.color = vbRed
spl.Cells(sat, 16).Font.color = vbRed
spl.Cells(sat, 17).Font.color = vbRed
End With
End If
ListView1.ListItems

.Checked = False
Next n
If say Mod (2) = 1 Then yzc.PrintOut ActivePrinter
Application.DisplayAlerts = True
If say > 0 Then
MsgBox say2 & " Adet Sayfada " & say & " Adet Kayıt Yazdırıldı.", vbInformation, "ExcelCozum.com"
Else
MsgBox "Hiçbir Sayfa Yazdırılmadı. Listeden Seçim Yapınız.", vbInformation, "ExcelCozum.com"
End If
Application.ActivePrinter = "HB LaserJet Professional P1102"
Call SipListele
End Sub