AW: eigene Eingabemaske erstellen
19.11.2006 10:37:17
Fechter
Hi Franz,
vielen Dank für Deinen Vorschlag, nun bekomme ich einen Debugger auf Set Dia = UserForm3, ich zeige Dir mal die komplette Ausführung, evtl. fällt Dir mein Fehler auf!
Gruß Oli
Private Sub ComboBox1_Change()
End Sub
Private Sub CommandButton1_Click()
Suchen
End Sub
Sub Suchen()
Dim lng As Long
Dim i As Integer
Application.ScreenUpdating = False
With UserForm3
.ListBox1.Clear
Sheets(Daten).Activate
i = 0
For lng = 3 To ActiveSheet.UsedRange.Rows.Count
If InStr(LCase(Cells(lng, 1).Value), LCase(.TextBox1.Value)) > 0 Then
.ListBox1.AddItem Cells(lng, 1).Value
.ListBox1.Column(1, i) = Cells(lng, 2).Value
.ListBox1.Column(2, i) = Cells(lng, 3).Value
.ListBox1.Column(3, i) = Cells(lng, 4).Value
.ListBox1.Column(4, i) = Cells(lng, 5).Value
.ListBox1.Column(5, i) = Cells(lng, 6).Row
i = i + 1
Else
End If
Next lng
End With
Application.ScreenUpdating = True
End Sub
Private Sub UserForm()
Dim tblDaten As Worksheet
Set tblDaten = Worksheets(Daten)
'Eingabemaske ZB II
UserForm3.Caption = Sheets(Daten).Cells(2, 1).Value
'Beschriftungen für die Bezeichnungsfelder aus Tabelle holen With UserForm3
.Label1.Caption = tblDaten.Cells(2, 1).Value
.Label2.Caption = tblDaten.Cells(2, 2).Value
.Label3.Caption = tblDaten.Cells(2, 3).Value
.Label4.Caption = tblDaten.Cells(2, 4).Value
.Label5.Caption = tblDaten.Cells(2, 5).Value
.Label6.Caption = tblDaten.Cells(2, 6).Value
.Label7.Caption = tblDaten.Cells(2, 7).Value
.Label8.Caption = tblDaten.Cells(2, 8).Value
.Label9.Caption = tblDaten.Cells(2, 9).Value
.Label10.Caption = tblDaten.Cells(2, 10).Value
.ListBox1.ColumnCount = 6
.ListBox1.ColumnWidths = "70;70;100;70;150;50"
.TextBox1.SetFocus
End With
End Sub
Private Sub Label10_Click()
End Sub
Private Sub CommandButton2_Click()
'Datensatz erfassen
Dim Dia As UserForm
Dim Ing As Long
On Error Resume Next
Set Dia = UserForm3
Worksheets(Daten).Activate
Ing = Range("A65536").End(xlUp).Offset(1, 0).Row
With Dia
Cells(lng, 1).Value = "'" & .TextBox1.Value
Cells(lng, 2).Value = .TextBox2.Value
Cells(lng, 3).Value = .TextBox3.Value
Cells(lng, 4).Value = .TextBox4.Value
End With
End Sub
Private Sub CommandButton3_Click()
'Datensatz ändern
Dim lng As Long
Dim i As Integer
On Error Resume Next
lng = UserForm3.ListBox1.Column(5)
Sheets(Daten).Activate
With UserForm3
Cells(lng, 1).Value = .TextBox1.Value
Cells(lng, 2).Value = .TextBox2.Value
Cells(lng, 3).Value = .TextBox3.Value
Cells(lng, 4).Value = .TextBox4.Value
Cells(lng, 5).Value = .TextBox5.Value
Cells(lng, 6).Value = .TextBox6.Value
Cells(lng, 7).Value = .TextBox7.Value
Cells(lng, 8).Value = .TextBox8.Value
Cells(lng, 9).Value = .TextBox9.Value
Cells(lng, 10).Value = .TextBox1.Value
'Listbox aktualisieren
i = .ListBox1.ListIndex
.ListBox1.Column(0, i) = .TextBox1.Value
.ListBox1.Column(1, i) = .TextBox2.Value
.ListBox1.Column(2, i) = .TextBox3.Value
.ListBox1.Column(3, i) = .TextBox4.Value
.ListBox1.Column(4, i) = .TextBox5.Value
End With
End Sub
Private Sub CommandButton4_Click()
'Datensatz löschen
Dim lng As Long
On Error Resume Next
Sheets(Daten).Activate
lng = UserForm3.ListBox1.Column(5)
Sheets(Daten).Cells(UserForm3.ListBox1.Column(5), 1).EntireRow.Delete FelderLöschen
End Sub
Private Sub CommandButton5_Click()
'Eingabefelder löschen
Sub FelderLöschen()
Dim tb As Object
With UserForm3
.ListBox1.Clear
For Each tb In .Controls
If TypeName(tb) = "TextBox" Then tb.Text = ""
Next tb
End With
End Sub
Private Sub Label2_Click()
End Sub
Private Sub Label3_Click()
End Sub
Private Sub Label4_Click()
End Sub
Private Sub Label5_Click()
End Sub
Private Sub Label6_Click()
End Sub
Private Sub Label7_Click()
End Sub
Private Sub Label9_Click()
End Sub
Private Sub ListBox1_Click()
Dim lng As Integer
Sheets(Daten).Activate
lng = UserForm3.ListBox1.Column(5)
With UserForm3
TextBox1.Value = Cells(lng, 1).Value
TextBox2.Value = Cells(lng, 2).Value
TextBox3.Value = Cells(lng, 3).Value
TextBox4.Value = Cells(lng, 4).Value
TextBox5.Value = Cells(lng, 5).Value
TextBox6.Value = Cells(lng, 6).Value
TextBox7.Value = Cells(lng, 7).Value
TextBox8.Value = Cells(lng, 8).Value
TextBox9.Value = Cells(lng, 9).Value
TextBox10.Value = Cells(lng, 10).Value
End With
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub TextBox2_Change()
End Sub
Private Sub TextBox3_Change()
End Sub
Private Sub TextBox4_Change()
End Sub
Zelle in Excel
A B C D
1 Verdruckte Zulassungsbescheinigungen Teil II
2 43211243 #NV
3
4 Verdruckte ZB II Neu Zugeteilte ZB II Datum Pers.-Nr.
5 UB455555 UN45555555 04.06.2008 AD31019