couleur Police dans listview selon condition

poussy67

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
 
Trier par date Trier par votes
poussy67

poussy67

XLDnaute Occasionnel
poussy67 à dit:
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
Cliquez pour agrandir...

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
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
 
Vote positif 0 Vote négatif

Discussions similaires

P
  • Résolu(e)
Microsoft 365 Erreur d'exécution "9" :L'indice n'appartient pas à la sélection
Réponses
9
Affichages
1 K
pelerin65
P
D
  • Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
1 K
Dranreb
Dranreb
T
  • Question
XL 2021 message si une valeur n'existe pas
Réponses
6
Affichages
652
target
T
PORCHER
  • Question
Microsoft 365 L'indice n'appartient pas à la sélection
Réponses
8
Affichages
623
TooFatBoy
TooFatBoy
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
537
Compte Supprimé 979
C
lynyrd
  • Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
529
AtTheOne
AtTheOne
T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
2 K
thivame
T
M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
351
marie3107
M
F
  • Résolu(e)
Microsoft 365 Recherche à partir d'une TextBox
Réponses
4
Affichages
449
Francky79
F
Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
Nicolas JACQUIN

Membres actuellement en ligne

15 membres et 243 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 104
Messages
2 116 253
Membres
112 702
dernier inscrit
JRCa91