COLORIR LINHAS DE UMA LISTVIW

Private Sub Form_Load()

    Dim I As Long
    Dim LI As ListItem
    Dim ICO As Long
    
    With ListView1
        .ListItems.Clear
        .ColumnHeaders.Clear
        .ColumnHeaders.Add , , "Coluna 1"
        .ColumnHeaders.Add , , "Coluna 2"
        .ColumnHeaders.Add , , "Coluna 3"
        .View = lvwReport
        .SmallIcons = ImageList1
        .FullRowSelect = True
    End With
    
    Randomize Timer
    
    For I = 1 To 5
        ICO = Fix(Rnd * ImageList1.ListImages.Count) + 1
        Set LI = Form1.ListView1.ListItems.Add(, , "Info Principal", , ICO)
        LI.SubItems(1) = "Info Col 2"
        LI.SubItems(2) = "Info Col 3"
    Next

    If LVZebra(ListView1, Picture1, vbWhite, RGB(192, 192, 192)) = False Then
        MsgBox "Não foi possível criar as listras", vbCritical
    End If

    
End Sub

Function LVZebra(LV As ListView, Pic As PictureBox, Cor1 As Long, Cor2 As Long) As Boolean

    ' A idéia é simples, basta criar o zebrado como uma imagem
    ' num picturebox e coloca-la como imagem de fundo no listview
    
    Dim lHght As Long
    Dim lWdth As Long

    LVZebra = False
    
    ' Só proceda se o listview estiver em modo
    ' report e com pelo menos 1 linha
    If LV.View  lvwReport Then Exit Function
    If LV.ListItems.Count = 0 Then Exit Function
    
    ' Prepara o listview
    With LV
        .Picture = Nothing
        .Refresh
        .Visible = True
        .PictureAlignment = lvwTile
        ' Pega o comprimento
        lWdth = .Width
    End With
    
    ' Prepara o picturebox
    With Pic
        ' Apaga o que tiver nele (caso a gente precise chamar a função de novo)
        .AutoRedraw = False
        .Picture = Nothing
        .BackColor = vbWhite
        .Height = 1
        .AutoRedraw = True
        .BorderStyle = vbBSNone
        .ScaleMode = vbTwips
        ' Joga para fora do form
        .Top = Form1.Top - 10000
        .Width = Screen.Width
        .Visible = False
        .Font = LV.Font
        
        ' Iguala as propriedades de fonte do picturebox com o listview
        With .Font
            .Bold = LV.Font.Bold
            .Charset = LV.Font.Charset
            .Italic = LV.Font.Italic
            .Name = LV.Font.Name
            .Strikethrough = LV.Font.Strikethrough
            .Underline = LV.Font.Underline
            .Weight = LV.Font.Weight
            .Size = LV.Font.Size
        End With
        
        ' Pega a altura do primeiro item
        lHght = LV.ListItems(1).Height
        
        ' Ajusta a altura e largura do picturebox
        .Height = lHght * 2
        .Width = lWdth
        
        ' Desenha as 2 linhas, uma de cada cor
        Pic.Line (0, 0)-(lWdth, lHght), Cor1, BF
        Pic.Line (0, lHght)-(lWdth, (lHght * 2)), Cor2, BF
        .AutoSize = True
        .Refresh
        
    End With
    
    ' Insere no listview
    LV.Refresh
    LV.Picture = Pic.Image
    ' Sucesso
    LVZebra = True
    
End Function

Public Function WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  Select Case iMsg
    Case WM_NOTIFY
      Dim udtNMHDR As NMHDR
      CopyMemory udtNMHDR, ByVal lParam, 12&
      With udtNMHDR
        If .code = NM_CUSTOMDRAW Then
          Dim udtNMLVCUSTOMDRAW As NMLVCUSTOMDRAW
          CopyMemory udtNMLVCUSTOMDRAW, ByVal lParam, Len(udtNMLVCUSTOMDRAW)
          With udtNMLVCUSTOMDRAW.nmcd
            Select Case .dwDrawStage
              Case CDDS_PREPAINT
                WindowProc = CDRF_NOTIFYITEMDRAW
                Exit Function
              Case CDDS_ITEMPREPAINT
                  If Val(Form1.ListView1.ListItems(.dwItemSpec + 1).Text) = 100 Then
                     udtNMLVCUSTOMDRAW.clrText = vbBlack
                  Else
                     udtNMLVCUSTOMDRAW.clrText = vbRed
                  End If
'I used Listitem.Tag Property To Set color, though you can use Text etc.
                  udtNMLVCUSTOMDRAW.clrTextBk = Val(Form1.ListView1.ListItems(.dwItemSpec + 1).Tag)
                  CopyMemory ByVal lParam, udtNMLVCUSTOMDRAW, Len(udtNMLVCUSTOMDRAW)
                  WindowProc = CDRF_NEWFONT
                  Exit Function
            End Select
          End With
        End If
      End With
  End Select
  WindowProc = CallWindowProc(g_addProcOld, hwnd, iMsg, wParam, lParam)
End Function

Private Sub Form_Load()
  With ListView1
'    .FullRowSelect = True
    .View = lvwReport
    .ColumnHeaders.Add , , "Item Column"
    .ColumnHeaders.Add , , "Subitem 1"
    .ColumnHeaders.Add , , "Subitem 2"
    Dim i&
    For i = 1 To 30
      With .ListItems.Add(, , CStr(Int(200 * Rnd)))
        .SubItems(1) = "Subitem 1"
        .SubItems(2) = "Subitem 2"
        .Tag = QBColor(15)
        If i Mod 2 Then .Tag = CStr(vbBlack)   'CStr(QBColor(14))
      End With
    Next
    g_MaxItems = .ListItems.Count - 1
  End With
  g_addProcOld = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Call SetWindowLong(hwnd, GWL_WNDPROC, g_addProcOld)
End Sub

Function LVZebra(LV As ListView, Pic As PictureBox, Cor1 As Long, Cor2 As Long) As Boolean

E como faço para chamar este codigo de pois que eu fizer a minha pesquisa... tipo localizar todos que começam com A....

Ele localiza-os direitinho mas não colore nada.... isto porque eu usei o segundo codigo que vc me enviou....

Mas o segundo da estes erros que informei acima....

Bem lembro que aqui no site tinha um de colorir onde usava uma picture vermelha.. e um codigo, e ele coloria as linhas... mas acho que na migração de provedor este codigo se perdeu.... infelizmente....

Abraços e até +