Gruppe
Dialog
Problem
Nach Ausfüllen der letzten TextBox erfolgt Eintragung, die Werte in den TextBoxes werden zurückgesetzt und die erste TextBox wird zum Eintrag des nächsten Datensatz ausgewählt.
StandardModule: Modul1
Sub callform()
frmEintragen.Show
End Sub
ClassModule: frmEintragen
Dim bln As Boolean
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub TextBox2_Change()
If TextBox2.TextLength = 4 Then TextBox3.SetFocus
End Sub
Private Sub TextBox3_Change()
If TextBox3.TextLength = 4 Then TextBox4.SetFocus
End Sub
Private Sub TextBox4_Change()
If TextBox4.TextLength = 4 Then TextBox5.SetFocus
End Sub
Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
End Sub
Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
End Sub
Private Sub TextBox4_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
End Sub
Private Sub TextBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim iTxt As Integer, iRow As Integer
Dim sTxt As String
If bln Then
bln = False
Exit Sub
End If
For iTxt = 1 To 6
If iRow < Cells(Rows.Count, iTxt).End(xlUp).Row + 1 Then
iRow = Cells(Rows.Count, iTxt).End(xlUp).Row + 1
End If
Next iTxt
If iRow = 108 Then
Beep
MsgBox "Kein Eintrag mehr möglich!"
End
End If
For iTxt = 1 To 6
sTxt = Controls("TextBox" & iTxt).Text
Select Case iTxt
Case 1, 5, 6
Cells(iRow, iTxt).Value = sTxt
Case Else
Cells(iRow, iTxt).Value = TimeSerial(CInt(Left(sTxt, 2)), CInt(Right(sTxt, 2)), 0)
End Select
Controls("TextBox" & iTxt).Text = ""
Next iTxt
bln = True
TextBox1.SetFocus
End Sub