Bei Suche farblich hervorheben
27.10.2020 11:15:24
Robert
Habe mal noch ein Problem, bei welchen ich Eure Hilfe bräuchte. Hier im Forum wurde mir _ geholfen ein perfektes Suchen_Finden Makro zu erstellen. Es funktioniert perfekt. Was müsste ich wo einfügen um das Suchergebnis farblich zu untersetzen und bei Suchbeendigung die Hervorhebung auf den Urzustand zurückgesetzt wird. Also z.B. erst ganz helles Blau und dann wieder weiss. Nur als Beispiel.
Option Explicit
Private Sub CommandButton3_Click()
Dim strSearch As String, strFirstAddress As String
Dim objCell As Range, objWorksheet As Worksheet
Dim blnAbort As Boolean, blnFound As Boolean
strSearch = InputBox("Suchbegriff:", "Suche nach...")
If strSearch vbNullString Then
Do
For Each objWorksheet In ThisWorkbook.Worksheets
Set objCell = objWorksheet.Cells.Find(What:=strSearch, _
LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
If Not objCell Is Nothing Then
strFirstAddress = objCell.Address(External:=True)
blnFound = True
Do
Call Application.Goto(Reference:=objCell)
If MsgBox("Weitersuchen?", vbQuestion Or vbYesNo, "Abfrage") = vbNo _
Then
blnAbort = True
Exit Do
End If
Set objCell = objWorksheet.Cells.FindNext(After:=objCell)
If objCell Is Nothing Then Exit Do
Loop Until objCell.Address(External:=True) = strFirstAddress
End If
If blnAbort Then Exit For
Next
If objCell Is Nothing And Not blnFound Then
Call MsgBox("Suchbegriff nicht gefunden.", vbExclamation, "Hinweis")
Exit Do
ElseIf Not blnAbort Then
If MsgBox("Letze Fundstelle." & vbLf & vbLf & "Nochmal von vorne?", _
vbQuestion Or vbYesNo, "Abfrage") = vbNo Then Exit Do
End If
Loop Until blnAbort
End If
End Sub
Für Eure Bemühungen danke ich Euch im voraus.LG Robert