Userform zeigt sich nicht [Fehlermeldung]
16.08.2002 11:34:32
Andreas
Ich noch mal, die Userform rufe ich aus einem anderen Makro mit "Ergebnisse.show" auf.Als Fehlermeldung kommt:
Das angegebene Objekt konnte nicht gefunden werden...
Hier das Makro, aus dem ich die Userform aufrufen möchte, dabei ist im Hintergrund aber noch eine andere Userform aktiv...
Der Aufruf steht ganz unten...
--------------------
Option Explicit
Dim c
Dim ErsteAdresse
Dim i As Integer
Dim SuchZelle As Variant
Dim ende
Dim x
Dim lb_suchergebnisse
Option Base 1
Option Compare Text
Sub Suchen_und_anzeigen()
Dim Meldung As Byte, Pos As Byte
Dim Schleife As Byte, y As Byte
Dim Begriff, Suchen() As Variant
Dim Bereich As Range
Dim n%, x%, xZelle%, yZelle%
Dim xTabelle$(), Adresse$(), Text$
'Bereich festlegen
Set Bereich = Application.InputBox _
("Bitte den zu durchsuchenden Bereich eingeben " & vbCrLf & _
"(z.B.: A1:J1000), oder markieren Sie den Such-" & vbCrLf & _
"bereich im Tabellenblatt.", "Bereich festlegen", "A1:J1000", Type:=8)
'Suchbegriff eingeben
Begriff = InputBox _
("Bitte den zu suchenden Wert eingeben. Sollen 2 Werte" & vbCrLf & _
"gleichzeitig gesucht werden, dann mit Zeichen + " & vbCrLf & _
"voneinander trennen (z.B.: Summe+die)." & vbCrLf & vbCrLf & _
"ENTER ohne Wert = Abbruch", "S U C H M O D U S")
If Begriff = "" Then Exit Sub
Pos = InStr(Begriff, "+")
If Pos Then
ReDim Suchen(2)
Suchen(1) = Left(Begriff, Pos - 1)
Suchen(2) = Right(Begriff, Len(Begriff) - Pos)
Schleife = 2
Else
ReDim Suchen(1)
Suchen(1) = Begriff
Schleife = 1
End If
Application.ScreenUpdating = False
'Letzte Zelle des Bereiches ermitteln. Diese Zelle wird als Startzelle für
'die Suche deffiniert, da Suche nach dieser Zelle, also in erster Zelle
'des Bereiches beginnt.
With Worksheets(1).Range(Bereich.Address)
xZelle = .Columns(.Columns.Count).Column
yZelle = .Rows(.Rows.Count).row
End With
'Eigentlicher Suchvorgang (in allen Tabellenblättern)
x = 1
For y = 1 To Schleife
For n = 1 To Sheets.Count
With Sheets(n).Range(Bereich.Address)
Set c = .Find(Suchen(y), after:=Cells(yZelle, xZelle), LookIn:=xlValues)
If Not c Is Nothing Then
ErsteAdresse = c.Address
Do
ReDim Preserve Adresse(x): ReDim Preserve xTabelle(x)
xTabelle(x) = Sheets(n).Name
Adresse(x) = c.Address(RowAbsolute:=False, ColumnAbsolute:=False)
Set c = .FindNext(c)
x = x + 1
Loop While Not c Is Nothing And c.Address <> ErsteAdresse
End If
End With
Next n
Next y
Application.ScreenUpdating = True
'Die Anzahl der gefundenen Werte ist (x - 1), wenn keiner
'gefunden wurde dann ist x = 1
Select Case x
Case 1
Meldung = MsgBox("Es wurde kein übereinstimmender Wert gefunden", _
vbOKOnly, "G E F U N D E N E W E R T E")
Case Else
'Tabelle einfügen
'Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
'Ergebnis immer in gleiche Tabelle eintragen
Sheets("Suchergebnis").Select
Sheets("Suchergebnis").Range("A:B").Select
Selection.Delete
Sheets("Suchergebnis").Range("A1").Select
On Error Resume Next
With ActiveSheet
.Name = "Suchergebnis"
.[A1] = "Tabelle"
.[B1] = "Zelle"
For n = 1 To x - 1
.Cells(n + 1, 1) = xTabelle(n)
.Cells(n + 1, 2) = Adresse(n)
Next n
End With
Range("A1").Select
End Select
MsgBox ("Die Suche ist abgeschlossen!")
Ergebnisse.Show
End Sub