在列表视图VBA中为整行指定颜色

Question

我终于解决了这个问题。因为我没有找到任何可用的来源。

Answer 1

我用两步解决了这个问题。

1. 用数据填充列表视图

2. 然后逐行对各个数据进行着色。
   所以这是对我有用的代码。

    Private Sub UserForm_Initialize() 'Filling with data
    lrow = ThisWorkbook.Sheets(1).Range("A99999").End(xlUp) + 1
    With ListView1
        .View = lvwReport
         .FullRowSelect = True
        .LabelEdit = lvwManual
        .Appearance = cc3D
   
   With .ColumnHeaders
   .Add , , "column1", 16
   .Add , , "column2", 50
   .Add , , "column3", 75
   .Add , , "column4", 75
   .Add , , "column5", 55
   .Add , , "column6", 60
   .Add , , "column7", 70
   .Add , , "column8", 70
   .Add , , "column9", 70
   .Add , , "column10", 70
   End With
   
   For i = 2 To lrow
   Set li = .ListItems.Add(, , Sheets(1).Cells(i, 1).Text)'this is the first column
    'these are the sub columns
   li.ListSubItems.Add , , Sheets(1).Cells(i, 2).Text
   li.ListSubItems.Add , , Sheets(1).Cells(i, 3).Text
   li.ListSubItems.Add , , Sheets(1).Cells(i, 4).Text
   li.ListSubItems.Add , , Sheets(1).Cells(i, 5).Text
   li.ListSubItems.Add , , Sheets(1).Cells(i, 6).Text
   li.ListSubItems.Add , , Sheets(1).Cells(i, 7).Text
   li.ListSubItems.Add , , Sheets(1).Cells(i, 8).Text
   li.ListSubItems.Add , , Sheets(1).Cells(i, 9).Text
   li.ListSubItems.Add , , Sheets(1).Cells(i, 10).Text
   Next I
   End With
   ListView1_AfterUpdate
   End Sub
   
   Private Sub ListView1_AfterUpdate() 'the actual coloring
   Dim x, y, r, c As Integer
   r = ListView1.ListItems.Count
   c = ListView1.ColumnHeaders.Count - 1
   For y = 1 To c
   For x = 2 To r
   
   
        If Sheets(1).Cells(x, 20) <> "" Then 'condition for coloring
            ListView1.ListItems(x - 1).ListSubItems(y).ForeColor = RGB(150, 0, 30)
        Else
            ListView1.ListItems(x - 1).ListSubItems(y).ForeColor = vbBlack
        End If
        Next
   Next
   x = Empty 
   For x = 2 To r 'It is required since it distinguishes listitems and listsubitems.
        If Sheets(1).Cells(x, 20) <> "" Then
            ListView1.ListItems(x - 1).ForeColor = RGB(150, 0, 30)
   
        Else
            ListView1.ListItems(x - 1).ForeColor = vbBlack
        End If
        Next
   End Sub
   

Answer 2

我在使用 ListView 时遇到了同样的问题，这里有一个更有效的代码来同时添加和突出显示单元格。 `设置visibleRange = .Offset(0, 0).Resize(.Rows.count - 1,.Columns.count) _ .SpecialCells(xlCellTypeVisible)

        With Me.EscalationListView
            .ListItems.Clear
            For i = 1 To visibleRange.Rows.count
                Set listItem = .ListItems.Add(, , visibleRange.Cells(i, 2).Text)        'Start from Date Column not Quarter Column
                listItem.SubItems(1) = visibleRange.Cells(i, 3).Value
                listItem.SubItems(2) = visibleRange.Cells(i, 4).Value
                listItem.SubItems(3) = visibleRange.Cells(i, 5).Value
                listItem.SubItems(4) = visibleRange.Cells(i, 6).Value
                listItem.SubItems(5) = visibleRange.Cells(i, 7).Value
                statusTxt = visibleRange.Cells(i, 6).Text
                If statusTxt = "Escalated" Then
                    listItem.ListSubItems(4).ForeColor = vbRed
                Else
                    listItem.ListSubItems(4).ForeColor = vbGreen
                End If
                
            Next i
        End With`