Markierungen
30.11.2003 19:12:54
Steffen
ich habe eine Suchroutine gebastelt, die nach einem Begriff sucht, den man eingegeben hat. Die Zelle, in dem der gesuchte Begriff stehst, wird farblich markiert. Nun möchte ich mittels einer Schaltfläche in dem Arbeitsblatt diese Markierung wieder aufheben, allerdings bekomme ich das nicht hin. Das mit der Schaltfläche ist nicht das PRoblem, bloß das dazugehörige Makro bekomme ich nicht. Den Quellcode der Suche habe ich unten mal angehängt.
Würde mich freuen, wenn jemand Rat weiß.
Gruß
Sven
Private Sub Suchen()
Dim strSuchtext As String
Dim objBlatt As Worksheet
Dim objZelle As Range
Dim strErsteFundstelle As String
Dim intButton As Integer
'Zu suchenden Text abfragen; Vorgabe aus Registry lesen
strSuchtext = Trim(InputBox("Gesuchter Text:", APP_NAME, GetSetting(APP_NAME, "Einstellungen", "Suchtext", "")))
'Wenn Suchtext angegeben und nicht 'Abbrechen' gewählt, dann...
If strSuchtext > "" Then
'... Suchtext in Registry speichern
SaveSetting APP_NAME, "Einstellungen", "Suchtext", strSuchtext
'Alle Blätter durchlaufen
For Each objBlatt In ActiveWorkbook.Worksheets
'Verwendeten Bereich jedes Blatts durchsuchen
With objBlatt.UsedRange
'Suchfunktion aufrufen
Set objZelle = .Find(What:=strSuchtext, LookIn:=xlValues)
'Wenn erster Treffer, dann...
If Not objZelle Is Nothing Then
'... Fundstelle merken
strErsteFundstelle = objBlatt.Name & "!" & objZelle.Address
Do
'Blatt mit Fundstelle aktivieren
objBlatt.Activate
'Fundstelle markieren
'objZelle.Select
objZelle.Interior.ColorIndex = 35
'Anwender fragen, ob Suche fortgesetzt werden soll
intButton = MsgBox("Weiter suchen?", vbQuestion + vbYesNoCancel, APP_NAME)
'Wenn Antwort nicht 'Ja' lautet, dann...
If intButton <> vbYes Then
'... Makro beenden
Exit Sub
End If
'Nach nächstem Vorkommen suchen
Set objZelle = .FindNext(objZelle)
'Schleife wiederholen solange weitere Fundstellen auftauchen und erste Fundstelle noch nicht erreicht
Loop While Not objZelle Is Nothing And objBlatt.Name & "!" & objZelle.Address <> strErsteFundstelle
End If
End With
Next
MsgBox "Keine weiteren Fundstellen.", vbInformation, APP_NAME
End If
End Sub