Süzme işleminde değeri sıfır olanlar renkli olsun.

[s.savas]

Merhaba arkadaşlar.
3 Adet TextBox ve 3 Adet ComboBox ile Listview'da süzme işlemini aşağıdaki kod ile yapıyorum.

Listview'a yüklenen 8.Item'in değeri 0 ise bu satırın renklendirilmesini istiyorum. UserForm_Initialize olayında bu işlem

If l.SubItems(8) = "0" Or l.SubItems(8) = "" Then
l.ForeColor = vbBlue
l.Bold = True
For z = 1 To l.ListSubItems.Count
  l.ListSubItems(z).ForeColor = vbBlue
  l.ListSubItems(z).Bold = True
Next z
End If

kodu ile gerçekleşiyor ancak bu kodu RAPOR olayına entegre edemedim.

Sub RAPOR()
Dim i As Long, aaa, bbb, ccc, ddd, eee  As String
Set sr = Sheets("Onay Defteri " & Left(Sheets("SABİT").Range("F1"), 4))
ListView1.ListItems.Clear
With ListView1
For i = 2 To sr.Cells(65536, "A").End(xlUp).Row
    
If TextBox9.Value = "" Then
aaa = sr.Cells(i, "A").Value
Else
aaa = TextBox9.Value
End If
    
If TextBox10.Value = "" Then
bbb = sr.Cells(i, "B").Value
Else
bbb = TextBox10.Value
End If
    
If TextBox11.Value = "" Then
ccc = sr.Cells(i, "C").Value
Else
ccc = TextBox11.Value
End If


If ComboBox4.Value = "" Then
ddd = sr.Cells(i, "D").Value
Else
ddd = ComboBox4.Value
End If


If ComboBox5.Value = "" Then
eee = sr.Cells(i, "E").Value
Else
eee = ComboBox5.Value
End If

If ComboBox6.Value = "" Then
fff = sr.Cells(i, "L").Value
Else
fff = ComboBox6.Value
End If

   
aaa = UCase(Replace(Replace(aaa, "ı", "I"), "i", "İ"))
bbb = UCase(Replace(Replace(bbb, "ı", "I"), "i", "İ"))
ccc = UCase(Replace(Replace(ccc, "ı", "I"), "i", "İ"))
ddd = UCase(Replace(Replace(ddd, "ı", "I"), "i", "İ"))
eee = UCase(Replace(Replace(eee, "ı", "I"), "i", "İ"))
fff = UCase(Replace(Replace(fff, "ı", "I"), "i", "İ"))
 
If UCase(Replace(Replace(sr.Cells(i, "A").Value, "ı", "I"), "i", "İ")) _
Like "*" & aaa & "*" _
And UCase(Replace(Replace(sr.Cells(i, "B").Value, "ı", "I"), "i", "İ")) _
Like "*" & bbb & "*" _
And UCase(Replace(Replace(sr.Cells(i, "C").Value, "ı", "I"), "i", "İ")) _
Like "*" & ccc & "*" _
And UCase(Replace(Replace(sr.Cells(i, "D").Value, "ı", "I"), "i", "İ")) _
Like "*" & ddd & "*" _
And UCase(Replace(Replace(sr.Cells(i, "E").Value, "ı", "I"), "i", "İ")) _
Like "*" & eee & "*" _
And UCase(Replace(Replace(sr.Cells(i, "L").Value, "ı", "I"), "i", "İ")) _
Like "*" & fff & "*" Then

  
.ListItems.Add , , i
x = x + 1
.ListItems(x).ListSubItems.Add , , sr.Cells(i, "A")
.ListItems(x).ListSubItems.Add , , FormatDateTime(sr.Cells(i, "B"), vbGeneralDate)
.ListItems(x).ListSubItems.Add , , sr.Cells(i, "C")
.ListItems(x).ListSubItems.Add , , sr.Cells(i, "D")
.ListItems(x).ListSubItems.Add , , sr.Cells(i, "E")
.ListItems(x).ListSubItems.Add , , FormatCurrency(sr.Cells(i, "F"))
.ListItems(x).ListSubItems.Add , , FormatCurrency(sr.Cells(i, "G"))
.ListItems(x).ListSubItems.Add , , FormatCurrency(sr.Cells(i, "H"))
'.ListItems(x).ListSubItems.Add , , sr.Cells(i, "I")
.ListItems(x).ListSubItems.Add , , sr.Cells(i, "J")
.ListItems(x).ListSubItems.Add , , sr.Cells(i, "K")
.ListItems(x).ListSubItems.Add , , sr.Cells(i, "L")


End If
Next i
End With
Set sr = Nothing
Exit Sub
    On Error Resume Next
    With Application
            .ScreenUpdating = False
            .EnableEvents = False
End With
Set sr = Sheets("Onay Defteri " & Left(Sheets("SABİT").Range("F1"), 4))
ListView1.ListItems.Clear
ListView1.Sorted = False
Set Alan = sr.Range("A2:A" & sr.[A65536].End(3).Row)
Set Bul = Alan.Find(deg & "*")
If Not Bul Is Nothing Then
Adres = Bul.Address
Do
    satır = Bul.Row
With ListView1
                   .ListItems.Add , , sr.Cells(satır, "A")
                    x = x + 1
                     .ListItems(x).ListSubItems.Add , , sr.Cells(i, "A")
                     .ListItems(x).ListSubItems.Add , , sr.Cells(i, "B")
                     .ListItems(x).ListSubItems.Add , , sr.Cells(i, "C")
                     .ListItems(x).ListSubItems.Add , , sr.Cells(i, "D")
                     .ListItems(x).ListSubItems.Add , , sr.Cells(i, "E")
                     .ListItems(x).ListSubItems.Add , , sr.Cells(i, "F")
                     .ListItems(x).ListSubItems.Add , , sr.Cells(i, "G")
                     .ListItems(x).ListSubItems.Add , , sr.Cells(i, "H")
                     '.ListItems(x).ListSubItems.Add , , sr.Cells(i, "I")
                     .ListItems(x).ListSubItems.Add , , sr.Cells(i, "J")
                     .ListItems(x).ListSubItems.Add , , sr.Cells(i, "K")
                     .ListItems(x).ListSubItems.Add , , sr.Cells(i, "L")
 

End With
Set Bul = Alan.FindNext(Bul)
Loop While Not Bul Is Nothing And Bul.Address <> Adres
ListView1.Sorted = True  'Sıralama işlemini açtık.
ListView1.SortOrder = lvwAscending '(A dan Z ye küçükten büyüğe sıralı yap)
ListView1.SortOrder = 0
End If
Set sr = Nothing
Set Alan = Nothing
Set Bul = Nothing
With Application
            .EnableEvents = True
            .ScreenUpdating = True
End With
End Sub