Für eine Praktikantenbeurteilung gebe ich mittels Comboboxen in einer Userform ausgewählte Zahlenwerte in ein Arbeitsblatt. Das geht soweit ganz gut, jedoch möchte ich mehrere Eingaben hintereinander machen und nicht jedesmal die Userform neu starten.
Mit:
msg = MsgBox("Wollen Sie weitere Eingaben tätigen?", vbYesNo, "Weitere Eingaben?")
bekomme ich die Abfrage, ob noch ein Datensatz eingegeben werden soll.
Nur wie geht es dann weiter?
Der komplette Code der Form lautet:
Private i
Private Sub cmbBeurteilungskriterien_Click()
frmBeurteilungskriterien.Show
End Sub
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Dim i As Integer
Dim v As Integer
Dim lastrow As Integer
Dim ws As Worksheet
If cmbAuffassungsgabe.Value = "" And cmbUrteilsfaehigkeit.Value = "" And cmbInitiative.Value = " _
" And cmbVerhalten.Value = "" And cmbFachwissen.Value = "" And cmbBelastbarkeit.Value = "" And cmbMotivation.Value = "" And cmbArbeitsmenge.Value = "" And cmbSorgfalt.Value = "" And cmbTeamverhalten.Value = "" And cmbBemerkungen.Value = "" Then
MsgBox "Es wurden keine Eingaben getätigt"
Exit Sub
End If
For i = 1 To Worksheets.Count
If UCase(Worksheets(i).Name) = UCase(Me.txtNamePraktikant.Text) And Worksheets(i).Range(" _
A500").Value "" Then
MsgBox "Achtung! Die maximale Eingabemöglichkeit ist erreicht, es können keine Eingaben _
mehr getätigt werden."
Unload Me
Exit Sub
End If
If UCase(Worksheets(i).Name) = UCase(Me.txtNamePraktikant.Text) Then
Set frm = frmTagesbeurteilung
Set ws = Worksheets(i)
ws.Unprotect "starten"
lastrow = ws.Range("A500").End(xlUp).Offset(1, 0).Row
With frm
ws.Cells(lastrow, 1) = .txtNamePraktikant.Value
ws.Cells(lastrow, 2) = .txtDatumTagesbeurteilung.Value
ws.Cells(lastrow, 3) = .txtNameAusbilder.Value
ws.Cells(lastrow, 4) = .cmbAuffassungsgabe.Value
ws.Cells(lastrow, 5) = .cmbInitiative.Value
ws.Cells(lastrow, 6) = .cmbVerhalten.Value
ws.Cells(lastrow, 7) = .cmbFachwissen.Value
ws.Cells(lastrow, 8) = .cmbBelastbarkeit.Value
ws.Cells(lastrow, 9) = .cmbMotivation.Value
ws.Cells(lastrow, 10) = .cmbArbeitsmenge.Value
ws.Cells(lastrow, 12) = .cmbSorgfalt.Value
ws.Cells(lastrow, 13) = .cmbTeamverhalten.Value
ws.Cells(lastrow, 14) = .cmbBemerkungen.Value
ws.Protect "starten"
End With
Worksheets(i).Visible = False
MsgBox "Hallo" & " " & txtNameAusbilder.Value & Chr(10) & "Deine Beurteilung für" & " " & _
txtNamePraktikant.Value & " " & "wurde übernommen"
Application.ScreenUpdating = True
Unload frmBeurteilungskriterien
Unload Me
Exit Sub
Else: v = 0
End If
Next i
If v = 0 Then
MsgBox "Achtung, der Name des Praktikanten stimmt nicht mit dem Tabellenblattnamen überein!"
Unload Me
End If
End Sub
Private Sub UserForm_Initialize()
txtNamePraktikant.Value = frmRettungsdienst.txtName.Value & " " & frmRettungsdienst. _
txtAusbildungsart.Value
Me.Caption = "Tagesbeurteilung für " & txtNamePraktikant.Value & " - " & "Heute am " & Date & " _
um " & Time
txtNamePraktikant.Locked = True
txtDatumTagesbeurteilung.Value = Date
txtNameAusbilder.Value = Sheets("Daten").Range("name2").Value
cmbAuffassungsgabe.SetFocus
cmbAuffassungsgabe.List = Sheets("Daten").Range("A1").CurrentRegion.Columns(3).Value
cmbUrteilsfaehigkeit.List = Sheets("Daten").Range("A1").CurrentRegion.Columns(3).Value
cmbInitiative.List = Sheets("Daten").Range("A1").CurrentRegion.Columns(3).Value
cmbVerhalten.List = Sheets("Daten").Range("A1").CurrentRegion.Columns(3).Value
cmbFachwissen.List = Sheets("Daten").Range("A1").CurrentRegion.Columns(3).Value
cmbBelastbarkeit.List = Sheets("Daten").Range("A1").CurrentRegion.Columns(3).Value
cmbMotivation.List = Sheets("Daten").Range("A1").CurrentRegion.Columns(3).Value
cmbArbeitsmenge.List = Sheets("Daten").Range("A1").CurrentRegion.Columns(3).Value
cmbSorgfalt.List = Sheets("Daten").Range("A1").CurrentRegion.Columns(3).Value
cmbTeamverhalten.List = Sheets("Daten").Range("A1").CurrentRegion.Columns(3).Value
cmbBemerkungen.List = Sheets("Daten").Range("A1").CurrentRegion.Columns(3).Value
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Unload frmRettungsdienst
frmRettungsdienst.Show
End Sub
Für eure Hilfe wäre ich recht dankbar.
Gruß Frank