AW: Name der Arbeitsmappe in Listbox
25.07.2003 11:52:08
Ivan
hi Nepumuk
also zu 1
das mit dem schließen hab ich nur als test für weitere dinge geplant.
das wird sowieso geändert.
und punkt 2
das ist ja nur die manuelle auswahl die ohne nachdenken
so gemacht habe . ich weis was du meinst 1 to 62 und so aber dazu hatte ich noch nicht gelegenheit.mir ist das nicht ganz klar wie ich das angehen soll.
der eigentliche code für die suchabfrage ist ja von dir und ramses.
hier der code.
'SUCHE
Private Sub Suche_Click()
Application.DisplayAlerts = False
Dim e As String
Dim s As String
Dim Found As Range
Dim FirstAddress As String
Dim i As Integer ' Zeile
'Neu
Dim CicI As Integer
On Error Resume Next
If Err.Number <> 0 Then
MsgBox "Kein Eintrag vorhanden!", vbCritical, "Schreiben Sie was rein"
End If
i = 0
If ComboBox1.Text = "" Then
MsgBox "Kein Eintrag vorhanden!", vbCritical, "Was soll ich den suchen?"
Suche.SetFocus
Else
End If
e = ComboBox1.Text
If e = "" Then Exit Sub
ListBox1.Clear
ListBox2.Clear
With ActiveSheet
Set Found = .Cells.Find(e, LookAt:=xlPart)
If Not Found Is Nothing Then
FirstAddress = Found.Address
ListBox1.ColumnCount = 1
ListBox1.AddItem Found
ListBox1.List(i, 1) = Cells(Found.Row, 13)
ListBox2.AddItem Found.Row
i = i + 1
Do
Found.Activate
Set Found = Cells.FindNext(After:=ActiveCell)
On Error Resume Next
If Found.Address = FirstAddress Then Exit Do
ListBox1.AddItem Found
ListBox1.List(i, 1) = Cells(Found.Row, 13)
ListBox2.AddItem Found.Row
i = i + 1
Loop
'Neu
Else
For CicI = Me.ComboBox2.Value + 1 To 62 'Wert aus der combobox übernehmen
Workbooks.Open Filename:="G:\Mappe" & CicI & ".xls"
Set Found = .Cells.Find(e, LookAt:=xlPart)
If Not Found Is Nothing Then
FirstAddress = Found.Address
ListBox1.ColumnCount = 1
ListBox1.AddItem Found
ListBox1.List(i, 1) = Cells(Found.Row, 13)
ListBox2.AddItem Found.Row
i = i + 1
Do
Found.Activate
Set Found = Cells.FindNext(After:=ActiveCell)
On Error Resume Next
If Found.Address = FirstAddress Then Exit Do
ListBox1.AddItem Found
ListBox1.List(i, 1) = Cells(Found.Row, 13)
ListBox2.AddItem Found.Row
i = i + 1
Loop
Exit For
End If
Next CicI
End If
End With
Suche.Caption = "Neue Suche"
UserForm1.TextBox3 = Range("H1")
Me.TextBox2 = Me.ListBox1.ListCount
Application.DisplayAlerts = True
End Sub
'Bei doppelklick In Listbox1 HYPERLINK folgen.
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Sheets("DB").Activate
On Error Resume Next
If Err.Number <> 0 Then
End If
Range("B" & CStr(ListBox2.List(ListBox1.ListIndex))).Hyperlinks(1).Follow
End Sub
danke
ivan