1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52
| Sub RechercheEtCouleur(Mot As String)
Dim Rng As Range, Sht As Worksheet
Dim FlgFind As Boolean
Dim reponse As Integer
Dim oldCel As String
' Initialiser le flag
FlgFind = False
' Pour chaque feuille du classeur
For Each Sht In ThisWorkbook.Sheets
' Eviter la recherche sur la feuille contenant le bouton
If Sht.Name = "Recherche" Then GoTo Suite
oldCel = Selection.Address 'pour se repositionner ensuite
On Error Resume Next
'effectue la recherche
Set Rng = Sht.Cells.Find(What:=Mot, LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False)
'SearchDirection:=xlNext,
' Si aucune erreur, la valeur a été trouvée
If Not Rng Is Nothing Then
' Si la valeur a été trouvée
FlgFind = True
' On active la feuille ansi que la cellule
Sht.Activate: Rng.Select
With Rng.Characters(Start:=InStr(1, Selection, Left(Mot, 1), 1), Length:=Len(Mot))
.Font.ColorIndex = 3 'colorie en rouge
.Font.Bold = True 'met en gras
End With
' Remettre à ZERO la cellule trouvée
Set Rng = Nothing
End If
On Error GoTo 0
'nécessaire aussi pour stopper la recherche
If FlgFind = True Then
If MsgBox("Poursuivre recherche ?", vbYesNo) = vbYes Then
FlgFind = False
Selection.Font.ColorIndex = 0 'remise de la couleur noire
Selection.Font.Bold = False 'enlever le gras
Else
Selection.Font.ColorIndex = 0 'idem plus haut si le bouton non est choisi
Selection.Font.Bold = False
Exit For 'on sort lorsque l'on presse le bouton non
End If
End If
Suite:
Next Sht
If FlgFind = False Then
Sheets("Recherche").Activate
Range(oldCel).Select 'on reprend notre place
End If
End Sub |
Partager