Re: leere zeile löschen
16.06.2003 18:19:38
IVAN
HI NEPUMUKHIER DER CODE
Private Sub UserForm_Initialize()
ComboBox1.RowSource = "DB!A2:A" & Sheets("DB").Range("A65536").End(xlUp).Row
ListBox4.ColumnCount = 1
ListBox4.RowSource = "DB!AV1:AV" & Sheets("DB").Range("AV65536").End(xlUp).Row
'listbox spalten breite einstellen
Dim i As Integer
i = ActiveSheet.UsedRange.Rows.Count
ListBox1.ColumnWidths = "6 Pt"
ListBox4.ColumnWidths = "2 Pt"
With UserForm1.ComboBox1
i = ActiveSheet.UsedRange.Rows.Count
With UserForm1.ComboBox1
.ColumnCount = 1
.ColumnHeads = False
.ColumnWidths = "8cm;"
End With
End With
End Sub
Private Sub Userform_Activate()
Suche.Caption = "Suche"
End Sub
'suchen
Private Sub Suche_Click()
On Error Resume Next
If Err.Number <> 0 Then
MsgBox "Kein Eintrag vorhanden!", vbCritical, "Schreiben Sie was rein"
End If
Dim e As String
Dim s As String
Dim Found As Range
Dim FirstAddress As String
Dim i As Integer ' Zeile
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
End If
End With
Suche.Caption = "Neue Suche"
End Sub
'Hier erfolgt die Ausgabe des gesuchten
'in DER LISTBOX1
Private Sub ListBox1_Click()
If ListBox1.Value <> "" Then
On Error Resume Next
ListBox2.ListIndex = ListBox1.ListIndex
txtNachname = Cells(ListBox2.Value, 1)
txtVorname = Cells(ListBox2.Value, 2)
txtPlz = Cells(ListBox2.Value, 3)
txtOrt = Cells(ListBox2.Value, 4)
txtAdresse = Cells(ListBox2.Value, 5)
txtTelefon = Cells(ListBox2.Value, 6)
txtHandy = Cells(ListBox2.Value, 7)
txtFax = Cells(ListBox2.Value, 8)
txtEmail = Cells(ListBox2.Value, 9)
txtKennung = Cells(ListBox2.Value, 10)
txtAnmerkung = Cells(ListBox2.Value, 11)
'txtGesamtPreis = Cells(ListBox2.Value, 20) & " "
End If
End Sub
DANKE IVAN