Listview nesnesi içinde ki yazıların renklendirilmesi

[udentr2002]

Merhaba arkadaşlar;
Formda bir kaç örnek buldum ama yapamadım, kendi projeme uyarlayamadım.
Yapmak istediğim şey şu;

A6:AB ye kadar listview5 nesnesinde 28 sütunum var. Bu sütunda eğer, AA sütununda ki değer 0 ise listview5 nesnesinin o satırda ki yazılar açık yeşil renkte yazsın, AA sütununda ki değer 0 'dan küçük ise ise listview5 nesnesinin o satırda ki yazılar kırmızı renkte yazsın,

Listview nesnesine aşağıdaki kodlarla veri alıyorum.

Sub Rapor1()

Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim arrData() As Variant
    Dim lvi As ListItem
    Dim j As Long, formatType As String ' yeni eklediğim satır
   
    Set ws = ThisWorkbook.Worksheets("Rapor")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row
  
    arrData = ws.Range("A6:AB" & lastRow).Value

    Dim sat As Long, sh As Worksheet, deg As String, x As Long



ListView1.ListItems.Clear

    For i = 6 To lastRow
    x = x + 1
            
        ListView1.ListItems.Add , , i
        'ListView1.ListItems.Add , , x 's1.Cells(i, "A").Value
        ListView1.ListItems(x).SubItems(1) = ws.Cells(i, "a").Value
        ListView1.ListItems(x).SubItems(2) = ws.Cells(i, "b").Value
        ListView1.ListItems(x).SubItems(3) = ws.Cells(i, "c").Value
        ListView1.ListItems(x).SubItems(4) = Format(ws.Cells(i, "d").Value, "#,0")
        ListView1.ListItems(x).SubItems(5) = Format(ws.Cells(i, "e").Value, "#,##0.0000000")
        ListView1.ListItems(x).SubItems(6) = Format(ws.Cells(i, "f").Value, "#,##0.00000")
        ListView1.ListItems(x).SubItems(7) = ws.Cells(i, "g").Value
        ListView1.ListItems(x).SubItems(8) = Format(ws.Cells(i, "h").Value, "#,##0.000")
        ListView1.ListItems(x).SubItems(9) = ws.Cells(i, "ı").Value
        
        ListView1.ListItems(x).SubItems(10) = Format(ws.Cells(i, "j").Value, "#,##0.00000")
        ListView1.ListItems(x).SubItems(11) = Format(ws.Cells(i, "k").Value, "#,##0.00000")
        
        ListView1.ListItems(x).SubItems(12) = ws.Cells(i, "l").Value
        ListView1.ListItems(x).SubItems(13) = ws.Cells(i, "m").Value
        ListView1.ListItems(x).SubItems(14) = ws.Cells(i, "n").Value
        ListView1.ListItems(x).SubItems(15) = Format(ws.Cells(i, "o").Value, "#,##0.000")
        ListView1.ListItems(x).SubItems(16) = ws.Cells(i, "p").Value
        ListView1.ListItems(x).SubItems(17) = ws.Cells(i, "q").Value
        ListView1.ListItems(x).SubItems(18) = ws.Cells(i, "r").Value
        ListView1.ListItems(x).SubItems(19) = ws.Cells(i, "s").Value
        
        ListView1.ListItems(x).SubItems(20) = Format(ws.Cells(i, "t").Value, "#,##0.000")
        ListView1.ListItems(x).SubItems(21) = ws.Cells(i, "u").Value
        
        ListView1.ListItems(x).SubItems(22) = Format(ws.Cells(i, "v").Value, "#,0")
        ListView1.ListItems(x).SubItems(23) = Format(ws.Cells(i, "w").Value, "#,##0.00")
        
        
        ListView1.ListItems(x).SubItems(24) = ws.Cells(i, "x").Value
        ListView1.ListItems(x).SubItems(25) = ws.Cells(i, "y").Value
        ListView1.ListItems(x).SubItems(26) = Format(ws.Cells(i, "z").Value, "#,##0.000")
        ListView1.ListItems(x).SubItems(27) = Format(ws.Cells(i, "AA").Value, "#,##0.000")
        ListView1.ListItems(x).SubItems(28) = ws.Cells(i, "AB").Value
        
  Next
          
ListView1.FullRowSelect = True
ListView1.Gridlines = True

        
 
    
    
   



End Sub

 

[Levent Menteşoğlu]

Next satırından önce aşağıdaki satırları ekleyin.

For a = 1 To 28
if ws.Cells(i, "aa")=0 then
ListView5.ListItems(x).ListSubItems.Item(a).ForeColor = vbGreen
elseif ws.Cells(i, "aa")<0 then
ListView5.ListItems(x).ListSubItems.Item(a).ForeColor = vbRed
End If
Next

 

[udentr2002]

Next satırından önce aşağıdaki satırları ekleyin.

For a = 1 To 28
if ws.Cells(i, "aa")=0 then
ListView5.ListItems(x).ListSubItems.Item(a).ForeColor = vbGreen
elseif ws.Cells(i, "aa")<0 then
ListView5.ListItems(x).ListSubItems.Item(a).ForeColor = vbRed
End If
Next

Hocam merhaba;
ilginiz için teşekkürler. Emeğinize sağlık.
Hakkınızı helal edin

Saygılarımla