Vielen Dank erstmal für die Antwort, aber irgendwie komme ich damit nicht so richtig klar. Vermutlich sind meine Kenntnisse in der Materie doch ein wenig zu klein, noch.
Im Moment sieht mein Suchprogramm wie folgt aus:
Private Sub Suchen()
Dim antwort As Variant
Dim strSuchKatalogblattName As String
Dim strSuchtext As String
Dim objBlatt As Worksheet
Dim objSuchKatalogblatt As Worksheet
Dim objZelle As Range
Dim objZeile As Range
Dim strErsteFundstelle As String
Dim intButton As Integer
Dim objForm As UserForm
'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 001
If strSuchtext > "" Then
'... Suchtext in Registry speichern
SaveSetting APP_NAME, "Einstellungen", "Suchtext", strSuchtext
'Prüfen, ob SuchKatalogblatt bereits existiert
Set objSuchKatalogblatt = GetWorksheet(strSuchtext)
'Wenn SuchKatalogblatt nicht existiert, dann...
'If 004
If objSuchKatalogblatt Is Nothing Then
'Neues Katalogblatt anlegen
Set objSuchKatalogblatt = Worksheets.Add(After:=Worksheets(Worksheets.Count))
'Suchtext bildet Namen des SuchKatalogblattes
objSuchKatalogblatt.Name = strSuchtext
'If 004
Else
'Wenn SuchKatalogblatt existiert, dann...
'If 005
If Not objSuchKatalogblatt Is Nothing Then
'...Erlaubnis zum Überschreiben der vorhandenen Daten einholen
intButton = MsgBox("Suchkatalogblatt existiert bereits. Vorhandenes Suchkatalogblatt überschreiben?", vbQuestion + vbYesNo, APP_NAME)
'Wenn Anwender Erlaubnis gibt, dann...
'If 006
If intButton <> vbNo Then
'...Inhalte im verwendeten Bereich des Suchkatalogblattes löschen
objSuchKatalogblatt.UsedRange.ClearContents
'Ansonsten.., also, wenn der Anwender keine Erlaubnis zum überschreiben gebeben hat
'If 006
Else
'Wenn der Anwender die Erlaubnis nicht gibt, dann...
'If 007
If intButton <> vbYes Then
'...fragen, ob ein neues Suchkatalogblatt angelegt werden soll
intButton = MsgBox("Neues Suchkatalogblatt anlegen?", vbQuestion + vbYesNo, APP_NAME)
'End If 007
'End If
'Wenn der Anwender kein neues Katalogblatt anlegen möchte, dann...
'If 008
If intButton <> vbYes Then
'...ein Fenster mit der Meldung "Das existierende Suchkatalogblatt öffnen?"
intButton = MsgBox("Das existierende Suchkatalogblatt öffnen?", vbQuestion + vbYesNo, APP_NAME)
'Wenn die Antwort nicht 'Ja' lautet, also das existierende suchKatalogblatt nicht geöffnet werden soll, dann...
'If 009
If intButton <> vbYes Then
MsgBox "Suche abgebrochen6!", vbInformation, APP_NAME
Exit Sub
'If 009
Else
'Suchkatalogblatt aktivieren
objSuchKatalogblatt.Activate
Exit Sub
'End If 009
End If
'Wenn der Anwender doch ein neues Suchkatalogblatt anlegen möchte, dann...
'If 008
Else
'...fragen, wie das neue Suchkatalogblatt heißen soll; Vorgabe aus Regitry lesen
strSuchKatalogblattName = Trim(InputBox("Name des neuen Suchkatalogblattes:", APP_NAME, GetSetting(APP_NAME, "Einstellungen", "SuchKatalogblattName", "")))
'Wenn der neue SuchKatalogblattName eingegeben worden und nicht 'Abbrechen' gewählt wurde, dann...
'If 011
If strSuchKatalogblattName > "" Then
'... SuchKatalogblattName in Registry speichern
SaveSetting APP_NAME, "Einstellungen", "SuchKatalogblattName", strSuchKatalogblattName
'Ein neues SuchKatalogblatt anlegen
Set objSuchKatalogblatt = Worksheets.Add(After:=Worksheets(Worksheets.Count))
'Name des neuen SuchKatalogblattes
objSuchKatalogblatt.Name = strSuchKatalogblattName
'If 011
Else
MsgBox "Suche abgebrochen5!", vbInformation, APP_NAME
Exit Sub
'End If 011
End If
'End If 008
End If
'End If 006
End If
'End If 005
End If
'End If 004
End If
'End With
'End If 001
End If
'End If
'ab hier was geändert
'Ab hier was eingefügt
'SuchKatalogblatt gestalten
With objSuchKatalogblatt
'Spaltenformatierungen festlegen
.Columns(1).ColumnWidth = 10
.Columns(2).ColumnWidth = 26
.Columns(3).ColumnWidth = 24
.Columns(4).ColumnWidth = 7
.Columns(5).ColumnWidth = 24
.Columns(6).ColumnWidth = 26
.Columns("A").NumberFormat = "0000"
.Columns("B").NumberFormat = "0000"
.Columns("C").NumberFormat = "00"
'Zeileninhalte und -formatierungen festlegen
'Alle Zellinhalte links ausrichten
.Rows.HorizontalAlignment = xlLeft
With .Rows(1)
.Cells(1).Value = "CD-Nummer:"
.Cells(1).Font.Size = 8
.Cells(1).Font.Bold = True
End With
With .Rows(1)
.Cells(2).Value = "CD-Seite"
.Cells(2).Font.Size = 8
.Cells(2).Font.Bold = True
End With
With .Rows(1)
.Cells(3).Value = "Künstler"
.Cells(3).Font.Size = 8
.Cells(3).Font.Bold = True
End With
With .Rows(1)
.Cells(4).Value = "Album"
.Cells(4).Font.Size = 8
.Cells(4).Font.Bold = True
End With
'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 keine Fundstelle existiert
'Wenn erster Treffer, dann...
'If 003
If Not objZelle Is Nothing Then
'... Fundstelle merken
strErsteFundstelle = objBlatt.Name & "!" & objZelle.Address
Do
'Blatt mit Fundstelle aktivieren
objBlatt.Activate
'Fundstelle markieren
objZelle.Select
'Anwender fragen, ob Suche fortgesetzt werden soll
intButton = MsgBox("Weiter suchen?", vbQuestion + vbYesNo, APP_NAME)
'Wenn Antwort nicht 'Ja' lautet, dann...
'If 010
If intButton <> vbYes Then
'Fenster mit "Suche abgebrochen!" öffnen und...
MsgBox "Suche abgebrochen4!", vbInformation, APP_NAME
'... Makro beenden
Exit Sub
'If 010
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
'Else
'Infobox mit "Keine Fundstellen!" öffnen und....
'MsgBox "Keine Fundstellen.", vbInformation, APP_NAME
'...Makro beenden
'Exit Sub
'If 003
End If
End With
Next
MsgBox "Keine weiteren Fundstellen.", vbInformation, APP_NAME
'Fragen, ob das Suchkatalogblatt geöffnet werden soll
intButton = MsgBox("Das Suchkatalogblatt öffnen?", vbQuestion + vbYesNo, APP_NAME)
'Wenn die Antwort nicht 'Ja' lautet, dann...
'If 015
If intButton <> vbYes Then
'Infofenster mit "Suche beendet!" öffnen und...
MsgBox "Suche beendet3!", vbInformation, APP_NAME
'...Makro beenden
Exit Sub
'If 015
Else
'Suchkatalogblatt aktivieren
objSuchKatalogblatt.Activate
Exit Sub
'If 015
End If
'If 001
'End If
End With
'End If
'strSuchtext = Trim(InputBox("Bitte geben Sie einen Suchtext ein und drücken sie OK, um die Suche zu beginnen oder auf Abbrechen, um die Suche abzubrechen:", APP_NAME, GetSetting(APP_NAME, "Einstellungen", "Suchtext", "")))
'Wenn bei der erneuten Abfrage nach einem Suchtext auf 'Abbrechen' gedrückt wird....
End If
'Else
'Infobox mit"Suche abgebrochen!" öffnen....
'MsgBox "Suche abgebrochen20!", vbInformation, APP_NAME
Exit Sub
' End If
End Sub
Ein paar kleine Fehler sind noch drin, aber die bekomme ich denke ich selbst in den Griff. Ich bekomme allerdings das mit der Widerholten Abfrage nach einem Suchbegriff nicht hin, falls keine eingegeben und doch auf Ok geklickt wurde.
Wie muss ich das folgende mit meiner Sache kombinieren, damit es läuft?
Option Explicit
Public Sub test()
Dim antwort As Variant
Do
antwort = Application.InputBox("Bitte Suchbegriff eingeben.", "Eigabe")
If antwort = False Then Exit Do
If Trim(antwort) <> "" Then
Call suchen((antwort))
Exit Do
End If
MsgBox "Gib doch bitte was ein, oder klick auf abbrechen.", 48, "Hinweis"
Loop
End Sub
Private Sub suchen(suchbegriff As String)
' hier kommt dein Suchprogramm
End Sub
Würde mich freuen, wenn mir da jemand weiter helfen könnte.
Gruß
Peppi