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

[CGU2022.]

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

 

[patricktoulon]

Bonjour
on ne peut pas mettre plusieurs couleurs de texte dans une même listbox
il faut utiliser un ListVieW pour ça mais déprécié en 64 bits