Option Explicit
Option Compare Text
Const Sign As String = "recherche"
'ICI C'est la mise en place initialisation
Private Sub recherche_Initialize()
'pour la date du jour
Me.Caption = Format(Date, "dddd dd mmmm yyyy")
With affichage
.ColumnCount = 7
.ColumnWidths = "100;100;0;100;100;100;0"
End With
Me.CommandButton1.Default = True
' pour définir la couleur des objets lors de l'initialisation d'un UserForm.
With recherche
.BackColor = &H8000000F
.CommandButton1.BackColor = &H8000000F
.CommandButton2.BackColor = &H8000000F
.Label3.BackColor = &H8000000F
End With
End Sub
Private Sub affichage_Click()
End Sub
Private Sub CommandButton1_Click()
Dim F As Worksheet
Dim Plage As Range, C As Range
Dim T As String, Firstaddress As String
Dim X As Integer
affichage.Clear
T = Me.recherche
If T = "" Then Exit Sub
For Each F In Worksheets
With F
Set Plage = Application.Intersect(.UsedRange.Cells, .Range(.Cells(8, 1), .Cells(.Rows.Count, .Columns.Count)))
End With
Set C = Plage.Find(T, LookIn:=xlValues, LookAt:=xlPart)
If Not C Is Nothing Then
Firstaddress = C.Address
Do
With affichage
.AddItem F.Name
For X = 2 To 6
.List(.ListCount - 1, X - 1) = F.Cells(C.Row, X).Text
Next X
.List(.ListCount - 1, 6) = C.Address(False, False)
End With
Set C = Plage.FindNext(C)
Loop While Not C Is Nothing And C.Address <> Firstaddress
End If
Next F
If affichage.ListCount = 0 Then
MsgBox "Le Texte " & T & " n'a pas été trouvé" & vbLf & "Faites un essai sur une partie du nom", vbCritical, Sign
End If
End Sub
'ICI C'est la sélection au Double Click & Sortie du UserForm
Private Sub affichage_dblClick(ByVal Cancel As MSForms.ReturnBoolean)
With affichage
Application.Goto Sheets(.Text).Range(.List(.ListIndex, 6))
End With
Unload Me
End Sub
'ICI Sortie du UserForm
Private Sub CommandButton2_Click()
Unload Me
End Sub
