Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2013 couleur texte listbox en fonction des lignes d'une feuille

CGU2022.

XLDnaute Junior
Bonjour a toutes et tous ...

Auriez vous un début de code
J'ai une listbox1 qui récupère les lignes de la feuille1

Je souhaite que dans la listbox (seulement) :
ligne 10 à 20 texte couleur1
ligne 30 à 40 texte couleur2
ligne 50 à 60 texte couleur3



Ci dessous le code de de la listbox pour la recherche.
'code module recherche listbox:
Option Compare Text
Dim f, choix(), Rng, Ncol


Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Set f = ActiveSheet
Set Rng = f.range("a17:L" & f.[a65000].End(xlUp).Row)
decal = Rng.Row - 1
Ncol = Rng.Columns.Count
TblTmp = Rng.Value
Ncol = Rng.Columns.Count - 1
ReDim choix(1 To UBound(TblTmp))
For i = LBound(TblTmp) To UBound(TblTmp)
TblTmp(i, Ncol + 1) = i + decal
For k = 1 To Ncol
choix(i) = choix(i) & TblTmp(i, k) & "|"
Next k
choix(i) = choix(i) & (i + decal) & "|"
Next i
'Call Tri(TblTmp, 1, LBound(TblTmp), UBound(TblTmp))
Me.ListBox1.List = TblTmp
End Sub

Private Sub TextBoxRech_Change()
Application.ScreenUpdating = False
If Me.TextBoxRech <> "" Then
mots = Split(Trim(Me.TextBoxRech), " ")
Tbl = choix
For i = LBound(mots) To UBound(mots)
Tbl = Filter(Tbl, mots(i), True, vbTextCompare)
Next i
n = 0: Dim b()
For i = LBound(Tbl) To UBound(Tbl)
a = Split(Tbl(i), "|")
n = n + 1: ReDim Preserve b(1 To Ncol + 1, 1 To n)
For k = 1 To Ncol
b(k, i + 1) = a(k - 1)
Next k
b(k, i + 1) = a(k - 1)
Next i
If n > 0 Then
ReDim Preserve b(1 To Ncol + 1, 1 To n + 1)
Me.ListBox1.List = Application.Transpose(b)
Me.ListBox1.RemoveItem n
End If
Else
UserForm_Initialize
End If
End Sub
 

Discussions similaires

Réponses
3
Affichages
572
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…