AW: VBA Zeiterfassung Mitarbeiter
15.11.2019 11:58:34
fcs
Hallo Mike,
ich hab den Code des Userforms entsprechend angepasst.
Die 3 Prozeduren unten musst du austauschen.
Die nachfolgende ID-Nummer wird jetzt anders ermittelt (Max-Wert in Spalte G + 1)
Die Combobox mit der Namensauswahl wird mit den in Spalte B vorkommenden Namen gefüllt.
Die Datei wird nach jeder Dateneingabe gespeichert.
Bei der Überprüfung der Eingabewerte wird zusätzlich geprüft, ob nur einer der 4 Togglebuttons aktiviert ist.
LG
Franz
Private Sub UserForm_Initialize()
txtName = ""
txtName.SetFocus
'Variable declaration
Dim IdVal As Integer
Dim Zelle As Range
Dim objCol As New Collection
'Next ID-Number on the Data Sheet
IdVal = Application.WorksheetFunction.Max(Sheets("Data").Range("G:G")) + 1
'Update next available id on the userform
frmData.txtId = IdVal
Me.tDatum.Text = "" & Date & " "
'Auswahlliste für Namen in Combobox erstellen
On Error Resume Next
For Each Zelle In Sheets("Data").ListObjects(1).DataBodyRange.Columns(2).Cells
If Trim(Zelle.Text) "" Then
objCol.Add Zelle.Text, Zelle.Text
End If
Next
Me.txtName.Clear
For IdVal = 1 To objCol.Count
Me.txtName.AddItem objCol(IdVal)
Next
Err.Clear
End Sub
Sub cmdAdd_Click()
On Error GoTo ErrOccured
'Boolean Value
BlnVal = 0
'Data Validation
Call Data_Validation
'Check validation of all fields are completed are not
If BlnVal = 0 Then Exit Sub
'TurnOff screen updating
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Variable declaration
Dim txtId, txtKommen, txtPause, txtEnde, txtGehen, txttDatum
Dim iCnt As Integer
Dim bolVorhanden As Boolean
Dim Zeile As Long
'find next available row to update data in the data worksheet
iCnt = fn_LastRow(Sheets("Data")) + 1
Dim lngErsteLeereZeile As Long
'Prüfen ob schon ein Eintrag am Datum vorhanden
bolVorhanden = False
With Sheets("Data")
For Zeile = .ListObjects(1).Range.Row + 1 To iCnt - 1
If .Cells(Zeile, 1).Text = Me.tDatum And .Cells(Zeile, 2).Text = Me.txtName Then
bolVorhanden = True
iCnt = Zeile
Exit For
End If
Next Zeile
'Update userform data to the Data Worksheet
If bolVorhanden = False Then
.Cells(iCnt, 7) = Application.WorksheetFunction.Max(.Range("G:G")) + 1
.Cells(iCnt, 2) = frmData.txtName
.Cells(iCnt, 1) = tDatum
End If
'Find Gender value
If frmData.obKommen = True Then
txtKommen = "" & Time & " "
If .Cells(iCnt, 3).Text "" Then
MsgBox "Für den " & .Cells(iCnt, 1).Text & " ist schon die KOMMEN-Zeit " _
& .Cells(iCnt, 3).Text & " eingetragen", vbOKOnly, _
"Hinweis": frmData.obKommen = False: Exit Sub
End If
.Cells(iCnt, 3) = txtKommen
End If
If frmData.obPause = True Then
txtPause = "" & Time & " "
If .Cells(iCnt, 4).Text "" Then
MsgBox "Für den " & .Cells(iCnt, 1).Text & " ist schon die PAUSE-A-Zeit " _
& .Cells(iCnt, 4).Text & " eingetragen", vbOKOnly, _
"Hinweis": frmData.obPause = False: Exit Sub
End If
.Cells(iCnt, 4) = txtPause
End If
If frmData.obEnde = True Then
txtEnde = "" & Time & " "
If .Cells(iCnt, 5).Text "" Then
MsgBox "Für den " & .Cells(iCnt, 1).Text & " ist schon die PAUSE-E-Zeit " _
& .Cells(iCnt, 5).Text & " eingetragen", vbOKOnly, _
"Hinweis": frmData.obEnde = False: Exit Sub
End If
.Cells(iCnt, 5) = txtEnde
End If
If frmData.obGehen = True Then
txtGehen = "" & Time & " "
If .Cells(iCnt, 6).Text "" Then
MsgBox "Für den " & .Cells(iCnt, 1).Text & " ist schon die GEHEN-Zeit " _
& .Cells(iCnt, 6).Text & " eingetragen", vbOKOnly, _
"Hinweis": frmData.obGehen = False: Exit Sub
End If
.Cells(iCnt, 6) = txtGehen
End If
End With 'Sheets("Data")
'Display next available Id number on the Userform
'Variable declaration
Dim IdVal As Integer
'Finding last row in the Data Sheet
IdVal = Application.WorksheetFunction.Max(Sheets("Data").Range("G:G")) + 1
'Update next available id on the userform
frmData.txtId = IdVal
'Nach dem Speichern text ausgabe
Dim Antwort As Integer
ActiveWorkbook.Save
If ActiveWorkbook.Saved = False Then
Antwort = MsgBox(" Datei nicht gespeichert.")
Else
Antwort = MsgBox(" Datei gespeichert ")
End If
ErrOccured:
Application.ScreenUpdating = True
Me.txtName = Null
If obGehen.Value = False Then
obKommen.Value = False
obPause.Value = False
obEnde.Value = False
Else
obGehen.Value = False
obPause.Value = False
obEnde.Value = False
End If
Call UserForm_Initialize
End Sub
' Check all the data(except remarks field) has entered are not on the userform
Sub Data_Validation()
If txtName = "" Then
MsgBox "Bitte Namen Scannen!", vbInformation, "Name"
ElseIf frmData.obKommen = False And frmData.obGehen = False And frmData.obEnde = False _
And frmData.obPause = False Then
MsgBox "Auswahl wählen !", vbInformation, "Gender"
ElseIf (frmData.obKommen = True) + (frmData.obGehen = True) + (frmData.obEnde = True) _
+ (frmData.obPause = True)