cellule cibler par usf en couleur

[rudy dehaudt]

bonjour a tous
je solicite de nouveau votre aide pour m aider a colorier la celulle ( ou ligne )qui est cibler par l' USF de recherche ( fichier trouver sur le site " attention il faut changer d onglet pour afficher l'USF qui permet la recherche" )
ci joint le fichier complet ( merci a ceux qui ont participe a sa fonctionnaliter )

Cijoint.fr - Service gratuit de dépôt de fichiers

merci
A+

 

[Robert]

Re : cellule cibler par usf en couleur

Bonir Rudy, bonsoir le forum,

J'ai rajouté un TB1.Exit qui colore de rouge la liste à la sortie de cette TextBox1 (il faut donc cliquer sur la LB2 pour voir le résultat). La fermeture de l'Userform supprime le rouge.
le code :

Private Sub UserForm_Initialize()
Dim c As Integer
 
UF1.LB1.Clear
For c = 1 To Cells(1, 1).End(xlToRight).Column
    UF1.LB1.AddItem Cells(1, c).Value
Next c
    UF1.LB1.ListIndex = 1
    UF1.TB1 = "?"
    UF1.TB1.SelStart = 0
    UF1.TB1.SelLength = Len(UF1.TB1.Text)
End Sub
 
Private Sub TB1_Change()
Dim c As Integer
Dim l As Double
Dim n As Integer
Dim vc As String
Dim vs As String
 
For c = 1 To Cells(1, 1).End(xlToRight).Column
    If UF1.LB1.Value = Cells(1, c).Value Then Exit For
Next c
UF1.LB2.Clear
n = 0
UF1.LB3.Caption = "Aucune ligne sélectionnée"
vs = LCase(UF1.TB1.Text)
If UF1.TB1.TextLength < 1 Then Exit Sub
For l = 2 To Cells(65536, c).End(xlUp).Row
    If IsNumeric(Cells(l, c)) Then
        vc = Str(Cells(l, c))
    Else
        vc = LCase(Cells(l, c))
    End If
    If Not InStr(1, vc, vs) = 0 Then
        UF1.LB2.AddItem l & " : " & Cells(l, c).Value
        n = n + 1
    End If
Next l
If n > 0 Then UF1.LB2.ListIndex = 0
If n = 0 Then UF1.LB3.Caption = "Aucune ligne sélectionnée"
If n = 1 Then UF1.LB3.Caption = "Une ligne sélectionnée"
If n > 1 Then UF1.LB3.Caption = n & " lignes sélectionnées"
End Sub
 
Private Sub TB1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim l As Double
Dim c As Integer
Dim n As Integer
Dim vc As String
Dim vs As String
 
For c = 1 To Cells(1, 1).End(xlToRight).Column
    If UF1.LB1.Value = Cells(1, c).Value Then Exit For
Next c
UF1.LB2.Clear
n = 0
UF1.LB3.Caption = "Aucune ligne sélectionnée"
vs = LCase(UF1.TB1.Text)
If Me.TB1.Value = "?" Then Exit Sub
For l = 2 To Cells(65536, c).End(xlUp).Row
    If IsNumeric(Cells(l, c)) Then
        vc = Str(Cells(l, c))
    Else
        vc = LCase(Cells(l, c))
    End If
    If Not InStr(1, vc, vs) = 0 Then
        UF1.LB2.AddItem l & " : " & Cells(l, c).Value
        n = n + 1
        Rows(l).Interior.ColorIndex = 3
    End If
Next l
End Sub
Private Sub LB2_Click()
Cells(Val(Left(UF1.LB2.Value, InStr(1, UF1.LB2.Value, " "))), 2).Select
End Sub
Private Sub UserForm_Click()
Unload UF1
End Sub
 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
ActiveSheet.Rows.Interior.ColorIndex = xlNone
End Sub

 

[rudy dehaudt]

Re : cellule cibler par usf en couleur

merci robert
je viens de tester et c est impect
pour info ca supprime toute les couleurs de la feuille mais cela n a aucune inscidence sur le fichier
a bientot et merci
A+