Listview de koşula bağlı satırları renklendirme

[ILHAREFF]

Merhaba arkadaşlar,

Ekteki çalışmamda görüldüğü gibi aşağı da yazmış olduğum kodda son sütün da bulunan DEVAM_EDİYOR olan satırları Mavi Bitti yazan satırları da Kırmızı yapmak istiyorum ama bir türlü başaramadım yardımcı olursanız sevinirim. İyi çalışmalar.


Sub liste()
Dim x As Long
Dim stk As ListItem
lstKampanya.ListItems.Clear

For x = 11 To 1000000
If Sheets("Kampanya").Range("A" & x).Value = "" Then Exit For
Set stk = lstKampanya.ListItems.Add(Text:=Sheets("Kampanya").Range("A" & x).Value)
stk.SubItems(1) = Sheets("Kampanya").Range("B" & x).Value
stk.SubItems(2) = Sheets("Kampanya").Range("C" & x).Value
stk.SubItems(3) = Sheets("Kampanya").Range("D" & x).Value
stk.SubItems(4) = Sheets("Kampanya").Range("E" & x).Value
stk.SubItems(5) = Sheets("Kampanya").Range("F" & x).Value
stk.SubItems(6) = Sheets("Kampanya").Range("G" & x).Value
stk.SubItems(7) = Sheets("Kampanya").Range("H" & x).Value

' Renklendirme Bölümü
If Sheets("Kampanya").Range("H" & x).Value = "DEVAM_EDİYOR" Then
lstKampanya.ListItems(1).ForeColor = &HFF0000
For j = 1 To 7
lstKampanya.ListItems(1).ListSubItems(j).ForeColor = &HFF0000
Next j
End If
If Sheets("Kampanya").Range("H" & x).Value = "Bitti" Then
lstKampanya.ListItems(1).ForeColor = &HFF&
For j = 1 To 7
lstKampanya.ListItems(1).ListSubItems(j).ForeColor = &HFF&
Next j
End If

Next
End Sub

 

[Orion1]

Listviewde satırlar renklendirilemez.
Fontlar renklendirilebilir.

 

[ILHAREFF]

fontlarda razıyım..

 

[ILHAREFF]

Arkadaşlar yardım rica ediyorum..

 

[Korhan Ayhan]

Örnek dosyanızı ekler misiniz?

 

[ILHAREFF]

Koray bey,

Sayfadaki çalışmalara bakarak yol aldım ama bir yerlerde bir yanlış yapıyorum çözemedim yardımcı olursanız sevinirim örnek çalışmam ektedir.. Şimdiden teşekkürler ederim.

 

[Korhan Ayhan]

Deneyiniz.

Sub liste()
    Dim x As Long
    Dim stk As ListItem
    lstKampanya.ListItems.Clear
   
    For x = 11 To 1000000
        If Sheets("Kampanya").Range("A" & x).Value = "" Then Exit For
        Set stk = lstKampanya.ListItems.Add(Text:=Sheets("Kampanya").Range("A" & x).Value)
        stk.SubItems(1) = Sheets("Kampanya").Range("B" & x).Value
        stk.SubItems(2) = Sheets("Kampanya").Range("C" & x).Value
        stk.SubItems(3) = Sheets("Kampanya").Range("D" & x).Value
        stk.SubItems(4) = Sheets("Kampanya").Range("E" & x).Value
        stk.SubItems(5) = Sheets("Kampanya").Range("F" & x).Value
        stk.SubItems(6) = Sheets("Kampanya").Range("G" & x).Value
        stk.SubItems(7) = Sheets("Kampanya").Range("H" & x).Value
       
        If Sheets("Kampanya").Range("H" & x).Value = "Bitti" Then
            stk.ForeColor = vbRed
            For y = 1 To 7
                stk.ListSubItems(y).ForeColor = vbRed
            Next
        ElseIf Sheets("Kampanya").Range("H" & x).Value = "DEVAM_EDİYOR" Then
            stk.ForeColor = vbBlue
            For y = 1 To 7
                stk.ListSubItems(y).ForeColor = vbBlue
            Next
        End If
    Next
End Sub

 

[ILHAREFF]

Korhan bey çok teşekkürler ederim...