LISTVIEW COM ALTERAÇÃO DE COR EM COL COM CRITERIOS

WMR2018 18/07/2024 12:20:03
#503422

Bom dia pessoal,

Preciso preencher dados de uma tabela em um Listview... deu certo... segue o código abaixo:

Dim ListaCash As ListItem
lstCashBack.FullRowSelect = True
lstCashBack.LabelEdit = lvwManual
lstCashBack.Visible = True
lstCashBack.View = lvwReport
lstCashBack.HideSelection = False
lstCashBack.ListItems.Clear

lstCashBack.ColumnHeaders.Clear
lstCashBack.ColumnHeaders.Add , , "CÓDIGO", 1200
lstCashBack.ColumnHeaders.Add , , "CÓD.VENDA", 1200
lstCashBack.ColumnHeaders.Add , , "VLR.VENDA", 1200
lstCashBack.ColumnHeaders.Add , , "CASHBACK", 1200
lstCashBack.ColumnHeaders.Add , , "VALIDADE", 1200

sSQL = "SELECT CODIGO, COD_PEDIDO, VALOR_VENDA, VALOR_CASHBACK, VALIDADE " & _
        "From Pedidos_Cashback " & _
        "Where (COD_CLIENTE = 119) and ABATIDO = 0 and INVALIDO = 0 " & _
        "ORDER BY VALIDADE;"

Set r = dbData.OpenRecordset(sSQL)

If Not r Is Nothing Then
   Do While Not r.EOF
      'primeira coluna
      Set ListaCash = lstCashBack.ListItems.Add(, , r("CODIGO"))
      'segunda e terceira coluna, que são sub itens da coluna 1
        ListaCash.SubItems(1) = ValidateNull(r("COD_PEDIDO"))
        ListaCash.SubItems(2) = FormatNumber(ValidateNull(r("VALOR_VENDA")), 2)
        ListaCash.SubItems(3) = FormatNumber(ValidateNull(r("VALOR_CASHBACK")), 2)
        ListaCash.SubItems(4) = ValidateNull(r("VALIDADE"))
      r.MoveNext
   Loop
   
   If r.State  0 Then r.Close
   Set r = Nothing
End If

MsgBox lstCashBack.ListItems.Count

With lstCashBack
    For i = 1 To .ListItems.Count
        ListaCash.ListSubItems(3).Bold = True
        ListaCash.ListSubItems(3).ForeColor = vbRed
    Next i
End With

Porem preciso fazer duas modificações:
1. A coluna 3 ser toda em NEGRITO E VERMELHO
2. A coluna 4 é uma data... preciso ver a data de hoje e ver se falta menos de 10 dias para a data exibida... caso faltar 10 ou menos dias para a data.... somente essa data fica vermelha

Estou parado nessa parte que não coloca a coluna nergrito/vermelho

With lstCashBack
    For i = 1 To .ListItems.Count
        ListaCash.ListSubItems(3).Bold = True
        ListaCash.ListSubItems(3).ForeColor = vbRed
    Next i
End With

[/c]

EDSON.PEREIRA 01/08/2024 22:11:16
#503458

Olá!
seria isso que você quer
If (ConsultaRegistro.EOF = False) And (ConsultaRegistro.BOF = False) Then
While (ConsultaRegistro.EOF = False) And (ConsultaRegistro.BOF = False)
Set ObjLstItm = Me.lstPesquisa.ListItems.Add
With ObjLstItm
.SubItems(1) = TCase(ConsultaRegistro.Fields("CODIGOPREVIA").Value)
If Me.optChassi.Value = False Then .SubItems(2) = UCase(ConsultaRegistro.Fields("PLACA").Value) Else .SubItems(2) = UCase(ConsultaRegistro.Fields("CHASSI").Value)
If Not IsNull(ConsultaRegistro.Fields("NOME").Value) Then .SubItems(3) = TCase(ConsultaRegistro.Fields("NOME").Value) Else .SubItems(3) = Empty
If Not IsNull(ConsultaRegistro.Fields("DataValidade").Value) Then .SubItems(4) = ConsultaRegistro.Fields("DataValidade").Value Else .SubItems(4) = Empty
'Data de Validade
'WHERE DATA_FISCAL BETWEEN #07/04/1996# AND #07/09/1996#;
If ConsultaRegistro.Fields("DataValidade").Value <= VBA.CDate(Date) Then
.ListSubItems(2).ForeColor = &HFF&
.ListSubItems(3).ForeColor = &HFF&
.ListSubItems(4).ForeColor = &HFF&
.ListSubItems(4).Bold = True '.ForeColor = &HFF&
End If
End With
ConsultaRegistro.MoveNext
Wend
End If

OMAR2011 05/08/2024 13:51:30
#503468 Resposta escolhida

Se você ainda não encerrou, tente assim.
With lstCashBack
For I = 1 To .ListItems.Count
ListaCash.ListSubItems(I).ListSubItems(3).Bold = True
ListaCash.ListSubItems(I).ListSubItems(3).ForeColor = vbRed
Next I
End With

WMR2018 09/09/2024 20:33:50
#503544

Obrigado a todos

Página única

Tópico encerrado , respostas não são mais permitidas

Voltar