Bojour,
J'ai un moteur de recherche lorsqu'il trouve le mot cherché, je double clique dessus et il m'amène directement a la page et la cellule trouvé.
Je souhaiterai que la ligne ou se trouve le mot trouvé soit en surbrillance comme quant on sélection une ligne dans une feuille excel.
Voici le code de l'userform:
Option Compare Text
Sub EnTête()
Dim i%, lbvis As Boolean
If lbxPrest.RowSource <> "" Then
lbvis = True
Else
lbvis = False
End If
For i = 1 To 3
Controls("lbPr" & i).Visible = lbvis
Next i
End Sub
Private Sub cbQuit_Click()
Unload Me
End Sub
Private Sub cbValid_Click()
Dim Cel As Range
Application.ScreenUpdating = False
Me.ListView1.ListItems.Clear
If ComboBox1 <> "" Then
' For i = Sheets.Count To 1 Step -1 'en mode de la dernière feuille à la première
For i = 1 To Sheets.Count 'en mode de la première feuille à la dernière
If Sheets(i).Name <> "Recherche" Then
For Each Cel In Sheets(i).Range("A1:Z" & Sheets(i).Range("F" & Application.Rows.Count).End(xlUp).Row)
If Cel.Row > 3 And Cel <> "" Then
If Cel Like "*" & ComboBox1 & "*" Then
UserForm1.ListView1.ListItems.Add , , Cel
UserForm1.ListView1.ListItems(UserForm1.ListView1.ListItems.Count).ListSubItems.Add , , Sheets(i).Name
UserForm1.ListView1.ListItems(UserForm1.ListView1.ListItems.Count).ListSubItems.Add , , Cel.Address
End If
End If
Next Cel
End If
Next i
End If
Application.ScreenUpdating = True
End Sub
Private Sub ListView1_DblClick()
Dim Feuille As String, Cellule As String
Feuille = UserForm1.ListView1.SelectedItem.ListSubItems(1)
Cellule = UserForm1.ListView1.SelectedItem.ListSubItems(2)
If Me.ListView1.ListItems.Count <> 0 Then
Sheets(Feuille).Activate
Sheets(Feuille).Range(Cellule).Activate
End If
End Sub
Private Sub UserForm_Initialize()
With Me.ListView1
With .ColumnHeaders
'Titres des colonnes
.Clear
'Ajout des colonnes
.Add , , "Liste", 300, lvwColumnLeft
.Add , , "N° d'onglet", 100, lvwColumnLeft
.Add , , "Cellule", 90, lvwColumnLeft
End With
.View = lvwReport 'affichage en mode Rapport
.Gridlines = True 'affichage d'un quadrillage
.FullRowSelect = True 'Sélection des lignes comlètes
.LabelEdit = lvwManual
.HideSelection = False
.HotTracking = False
End With
End Sub
Par avance merci.