couleur Police dans listview selon condition

poussy67

XLDnaute Occasionnel
Bonjour le Forum

J'essaye depuis plusieurs d'adapter un code pour modifier la police dans
un listview sans résultat.
J'ai une listview avec plusieurs colonnes dans la derniere colonne il y une valeur
1 ou 2. Selon la valeur je voudrais que la ligne soit en gras et en couleur rouge ou vert.
J'ai essayé d'adapter un code sans resultat c'est la derniere colonne qui est en rouge et non la ligne.
Je fais appelle au pro de la VBA pour un coup de pouce

en vous remerciant d'avance

ci-joint le code
Sub IniListview2()
Dim i As Long, j, j1, j2 As Byte
Sheets("Attente").AutoFilterMode = False
'Remonte les données de la feuille des camion qui sont en Cam en Brie dans listview
With ListView2
.ListItems.Clear
With .ColumnHeaders
.Clear
.Add , , Sheets("Attente").Range("A7"), 70 '..............RDV
.Add , , Sheets("Attente").Range("B7"), 70 '..............Arrivée site
.Add , , Sheets("Attente").Range("C7"), 80 '..............Transporteur
.Add , , Sheets("Attente").Range("D7"), 45 '..............N° Immat
.Add , , Sheets("Attente").Range("E7"), 55 '..............N° commande
.Add , , Sheets("Attente").Range("F7"), 60 '..............N° groupage
.Add , , Sheets("Attente").Range("G7"), 150 '.............N° cde groupage
.Add , , Sheets("Attente").Range("H7"), 150 '.............Nom Client
.Add , , Sheets("Attente").Range("I7"), 150 '.............Destination
.Add , , Sheets("Attente").Range("J7"), 150 '..............N° Livraison
.Add , , Sheets("Attente").Range("K7"), 55 '..............N° Retour
.Add , , Sheets("Attente").Range("L7"), 30 '..............Prépa
.Add , , Sheets("Attente").Range("M7"), 30 '..............N° plaque
.Add , , Sheets("Attente").Range("N7"), 60 '.............Indicatifs+pays
.Add , , Sheets("Attente").Range("O7"), 60 '.............N° telephone
.Add , , Sheets("Attente").Range("P7"), 70 '..............Type cde
.Add , , Sheets("Attente").Range("Q7"), 70 '..............Attente
.Add , , Sheets("Attente").Range("R7"), 70 '..............Alerte
End With
.View = lvwReport
.FullRowSelect = True
.Gridlines = True
For i = 8 To Sheets("Attente").Range("A65536").End(xlUp).Row
.ListItems.Add , , Format(Sheets("Attente").Cells(i, 1), "dd/mm/yy hh:mm")

For j1 = 2 To 2
.ListItems(.ListItems.Count).ListSubItems.Add , , Format(Sheets("Attente").Cells(i, j1), "dd/mm/yy hh:mm")
Next
For j = 3 To 16
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Attente").Cells(i, j)
Next
For j = 17 To 17
.ListItems(.ListItems.Count).ListSubItems.Add , , Format(Sheets("Attente").Cells(i, j), "hh:mm")
Next
For j = 18 To 18
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Attente").Cells(i, j)
Next
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
.ListItems(.ListItems.Count).ListSubItems.Add , , i

If Sheets("Attente").Cells(i, 17) = 1 Then
.ListItems(.ListItems.Count).ListSubItems(17).ForeColor = &HFF00& ' '&HFF0000
Else
.ListItems(.ListItems.Count).ListSubItems(17).ForeColor = &HFF
End If
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Next
Set ListView2.SelectedItem = Nothing
End With
End Sub



Cdt
 

poussy67

XLDnaute Occasionnel
Bonjour le Forum

J'essaye depuis plusieurs d'adapter un code pour modifier la police dans
un listview sans résultat.
J'ai une listview avec plusieurs colonnes dans la derniere colonne il y une valeur
1 ou 2. Selon la valeur je voudrais que la ligne soit en gras et en couleur rouge ou vert.
J'ai essayé d'adapter un code sans resultat c'est la derniere colonne qui est en rouge et non la ligne.
Je fais appelle au pro de la VBA pour un coup de pouce

en vous remerciant d'avance

ci-joint le code
Sub IniListview2()
Dim i As Long, j, j1, j2 As Byte
Sheets("Attente").AutoFilterMode = False
'Remonte les données de la feuille des camion qui sont en Cam en Brie dans listview
With ListView2
.ListItems.Clear
With .ColumnHeaders
.Clear
.Add , , Sheets("Attente").Range("A7"), 70 '..............RDV
.Add , , Sheets("Attente").Range("B7"), 70 '..............Arrivée site
.Add , , Sheets("Attente").Range("C7"), 80 '..............Transporteur
.Add , , Sheets("Attente").Range("D7"), 45 '..............N° Immat
.Add , , Sheets("Attente").Range("E7"), 55 '..............N° commande
.Add , , Sheets("Attente").Range("F7"), 60 '..............N° groupage
.Add , , Sheets("Attente").Range("G7"), 150 '.............N° cde groupage
.Add , , Sheets("Attente").Range("H7"), 150 '.............Nom Client
.Add , , Sheets("Attente").Range("I7"), 150 '.............Destination
.Add , , Sheets("Attente").Range("J7"), 150 '..............N° Livraison
.Add , , Sheets("Attente").Range("K7"), 55 '..............N° Retour
.Add , , Sheets("Attente").Range("L7"), 30 '..............Prépa
.Add , , Sheets("Attente").Range("M7"), 30 '..............N° plaque
.Add , , Sheets("Attente").Range("N7"), 60 '.............Indicatifs+pays
.Add , , Sheets("Attente").Range("O7"), 60 '.............N° telephone
.Add , , Sheets("Attente").Range("P7"), 70 '..............Type cde
.Add , , Sheets("Attente").Range("Q7"), 70 '..............Attente
.Add , , Sheets("Attente").Range("R7"), 70 '..............Alerte
End With
.View = lvwReport
.FullRowSelect = True
.Gridlines = True
For i = 8 To Sheets("Attente").Range("A65536").End(xlUp).Row
.ListItems.Add , , Format(Sheets("Attente").Cells(i, 1), "dd/mm/yy hh:mm")

For j1 = 2 To 2
.ListItems(.ListItems.Count).ListSubItems.Add , , Format(Sheets("Attente").Cells(i, j1), "dd/mm/yy hh:mm")
Next
For j = 3 To 16
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Attente").Cells(i, j)
Next
For j = 17 To 17
.ListItems(.ListItems.Count).ListSubItems.Add , , Format(Sheets("Attente").Cells(i, j), "hh:mm")
Next
For j = 18 To 18
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Attente").Cells(i, j)
Next
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
.ListItems(.ListItems.Count).ListSubItems.Add , , i

If Sheets("Attente").Cells(i, 17) = 1 Then
.ListItems(.ListItems.Count).ListSubItems(17).ForeColor = &HFF00& ' '&HFF0000
Else
.ListItems(.ListItems.Count).ListSubItems(17).ForeColor = &HFF
End If
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Next
Set ListView2.SelectedItem = Nothing
End With
End Sub



Cdt
Re le forum

J'ai enfin trouvé la solution en cherchant dans le forum et en modifiant le code.
Merci au Forum

Bonne soirée

'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
.ListItems(.ListItems.Count).ListSubItems.Add , , i
For Co = 1 To 18
If Sheets("Attente").Cells(i, 18) = 1 Then
.ListItems(.ListItems.Count).ListSubItems(Co).ForeColor = &H80FF& 'Orange
.ListItems(.ListItems.Count).ListSubItems(Co).Bold = True

Else
If Sheets("Attente").Cells(i, 18) = 2 Then
.ListItems(.ListItems.Count).ListSubItems(Co).ForeColor = &HFF& 'Rouge
.ListItems(.ListItems.Count).ListSubItems(Co).Bold = True
Else
.ListItems(.ListItems.Count).ListSubItems(Co).ForeColor = &H8000& 'Noir
.ListItems(.ListItems.Count).ListSubItems(Co).Bold = True
End If
End If
Next
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
 

Discussions similaires


Haut Bas