So hier nun die komplette VBA:
und hier ist die dazugehörige Datei: https://www.herber.de/bbs/user/5065.xls
Beim ausführen des Makros "Wochentage eintragen" bekomme ich eine Fehlermeldung.
Bitte helft mir!
Dim t, m, j, wota, moza, arbbegmin, jmin, jstd, heutezelle, _
monatszahl, erstertag, monatsname, adr, adr1, adr2, Üstd
Sub test()
Application.OnSheetActivate = ActiveWorkbook.Name & _
"!Modul1.test3"
End Sub
Sub aaa()
Application.OnSheetActivate = ""
End Sub
Sub test3()
Sheets("formular").Select
WochentageEinfügen
End Sub
Sub MonatszahlausMonat()
With Worksheets("formular")
If .Range("G1").Value = "Jan" Then monatszahl = 1
If .Range("G1").Value = "Feb" Then monatszahl = 2
If .Range("G1").Value = "März" Then monatszahl = 3
If .Range("G1").Value = "April" Then monatszahl = 4
If .Range("G1").Value = "Mai" Then monatszahl = 5
If .Range("G1").Value = "Juni" Then monatszahl = 6
If .Range("G1").Value = "Juli" Then monatszahl = 7
If .Range("G1").Value = "Aug" Then monatszahl = 8
If .Range("G1").Value = "Sept" Then monatszahl = 9
If .Range("G1").Value = "Okt" Then monatszahl = 10
If .Range("G1").Value = "Nov" Then monatszahl = 11
If .Range("G1").Value = "Dez" Then monatszahl = 12
End With
End Sub
Sub WochentageEinfügen()
With ActiveWindow
.DisplayHorizontalScrollBar = False
.DisplayWorkbookTabs = False
End With
With Application
.DisplayFormulaBar = False
.DisplayStatusBar = False
End With
Toolbars(1).Visible = False
Toolbars(2).Visible = False
Toolbars(7).Visible = False
With Application
.ShowToolTips = True
.LargeButtons = False
.ColorButtons = True
End With
MonatszahlausMonat
m = monatszahl
j = Worksheets("formular").Range("H1").Value
MonatszahlErrechnen
For i = 7 To 7 + 30
t = i - 6
Worksheets("formular").Unprotect
Worksheets("formular").Cells(i, 1).Font.ColorIndex = 1
If t <= moza Then
MonatsnameErrechnen
If wota = 6 Or wota = 0 Or Worksheets("Tabelle2").Cells(t, 8) = 3 _
Then Worksheets("formular").Cells(i, 1).Font.ColorIndex = 3
If t = Day(Date) And m = Month(Date) And Int(j) = Year(Date) Then _
Worksheets("formular").Cells(i, 1).Font.ColorIndex = 4: heutezelle = i
If wota = 1 Then Worksheets("formular").Cells(i, 1).Value = "Mo " & i - 6 & "."
If wota = 2 Then Worksheets("formular").Cells(i, 1).Value = "Di " & i - 6 & "."
If wota = 3 Then Worksheets("formular").Cells(i, 1).Value = "Mi " & i - 6 & "."
If wota = 4 Then Worksheets("formular").Cells(i, 1).Value = "Do " & i - 6 & "."
If wota = 5 Then Worksheets("formular").Cells(i, 1).Value = "Fr " & i - 6 & "."
If wota = 6 Then Worksheets("formular").Cells(i, 1).Value = "Sa " & i - 6 & "."
If wota = 0 Then Worksheets("formular").Cells(i, 1).Value = "So " & i - 6 & "."
If i = 7 Then erstertag = wota
Else
Worksheets("formular").Cells(i, 1).Value = ""
End If
Next i
Worksheets("formular").DrawingObjects("WotaEintragen").Font.FontStyle = "standard"
Worksheets("formular").DrawingObjects("WotaEintragen").Font.ColorIndex = 1
Worksheets("formular").Protect
Worksheets("Tabelle2").Range("D1").Value = monatszahl
Worksheets("Tabelle2").Range("D2").Value = Worksheets("formular").Range("H1").Value
'z = MsgBox("Soll die Rahmenarbeitszeit auch übernommen werden?", 4)
'If z = 6 Then RahmenarbeitszeitÜbernehmen
'Worksheets("Tabelle2").Hide
End Sub
Sub DrehfeldMonat()
Worksheets("formular").Unprotect
z = Worksheets("formular").DrawingObjects("ÄndernMonat").Value
Select Case z
Case 1: Worksheets("formular").Range("G1").Value = "Jan"
Case 2: Worksheets("formular").Range("G1").Value = "Feb"
Case 3: Worksheets("formular").Range("G1").Value = "März"
Case 4: Worksheets("formular").Range("G1").Value = "April"
Case 5: Worksheets("formular").Range("G1").Value = "Mai"
Case 6: Worksheets("formular").Range("G1").Value = "Juni"
Case 7: Worksheets("formular").Range("G1").Value = "Juli"
Case 8: Worksheets("formular").Range("G1").Value = "Aug"
Case 9: Worksheets("formular").Range("G1").Value = "Sept"
Case 10: Worksheets("formular").Range("G1").Value = "Okt"
Case 11: Worksheets("formular").Range("G1").Value = "Nov"
Case 12: Worksheets("formular").Range("G1").Value = "Dez"
End Select
Worksheets("formular").DrawingObjects("WotaEintragen").Font.FontStyle = "Fett Kursiv"
Worksheets("formular").DrawingObjects("WotaEintragen").Font.ColorIndex = 3
If (Worksheets("Tabelle2").Range("D1").Value = z) And _
(Fix(Worksheets("Tabelle2").Range("D2").Value) = _
Fix(Worksheets("formular").Range("H1").Value)) Then
If Worksheets("tabelle2").Range("D3").Value = 1 Then
Worksheets("formular").DrawingObjects("Wochenzeit").Font.FontStyle = "standard"
Worksheets("formular").DrawingObjects("Wochenzeit").Font.ColorIndex = 1
End If
Else
Worksheets("formular").DrawingObjects("Wochenzeit").Font.FontStyle = "Fett Kursiv"
Worksheets("formular").DrawingObjects("Wochenzeit").Font.ColorIndex = 3
End If
Worksheets("formular").Protect
End Sub
Sub DrehfeldJahr()
Worksheets("formular").Unprotect
z = Worksheets("formular").DrawingObjects("ÄndernJahr").Value
Worksheets("formular").Range("H1").Value = z
Worksheets("formular").DrawingObjects("WotaEintragen").Font.FontStyle = "Fett Kursiv"
Worksheets("formular").DrawingObjects("WotaEintragen").Font.ColorIndex = 3
MonatszahlausMonat
If (Worksheets("Tabelle2").Range("D1").Value = monatszahl) And _
(Fix(Worksheets("Tabelle2").Range("D2").Value) = Fix(z)) Then
If Worksheets("tabelle2").Range("D3").Value = 1 Then
Worksheets("formular").DrawingObjects("Wochenzeit").Font.FontStyle = "standard"
Worksheets("formular").DrawingObjects("Wochenzeit").Font.ColorIndex = 1
End If
Else
Worksheets("formular").DrawingObjects("Wochenzeit").Font.FontStyle = "Fett Kursiv"
Worksheets("formular").DrawingObjects("Wochenzeit").Font.ColorIndex = 3
End If
Worksheets("formular").Protect
End Sub
Sub MonatsnameErrechnen()
Select Case m
Case 1, 10: x = 0
Case 2, 3, 11: x = 3
Case 4, 7: x = 6
Case 5: x = 1
Case 6: x = 4
Case 8: x = 2
Case 9, 12: x = 5
End Select
y = j - 1900
z = y + Int(y / 4) + x + t
TAG(DATUM(B1;B2+1;0))
' nun noch Schaltjahr ausschalten (wie witzig)
If (j / 4 = Int(j / 4) And j / 400 <> Int(j / 400)) Or j = 2000 And m < 3 Then z = z - 1
wota = z Mod 7
End Sub
Sub MonatszahlErrechnen()
Select Case m
Case 1, 3, 5, 7, 8, 10, 12: moza = 31
Case 4, 6, 9, 11: moza = 30
Case 2
moza = 28
If (j / 4 = Int(j / 4) And j / 400 <> Int(j / 400)) Or j = 2000 Then moza = 29
End Select
End Sub
Sub ArbeitsbeginnEintragen()
q = False
MonatszahlausMonat
m = monatszahl
j = Worksheets("formular").Range("H1").Value
MonatszahlErrechnen
For i = 7 To 7 + 30
t = i - 6
If t <= moza Then
MonatsnameErrechnen
If t = Day(Date) And m = Month(Date) And Int(j) = Year(Date) Then _
heutezelle = i: q = True
End If
Next i
If Worksheets("Tabelle2").Cells(heutezelle - 6, 8).Value = 0 Then
If q Then
jstd = Hour(Now)
jmin = Minute(Now)
zeit = jstd & ":" & Right$("00" + jmin, 2)
DialogSheets("Arbeitsbeginn").TextBoxes("txtArbbegzeit").Text = zeit
DialogSheets("Arbeitsbeginn").TextBoxes("txtArbbegmin").Text _
= Worksheets("Tabelle2").Range("B1").Value
DialogSheets("Arbeitsbeginn").Show
Else
MsgBox ("Die Arbeitszeit kann nicht automatisch eingetragen" & _
Chr(13) & "werden, da das aktuelle Datum nicht auf dem aktiven" _
& Chr(13) & "Blatt zu finden ist!")
End If
Else
MsgBox ("Der Feldstatus dieses Tags muß erst auf ZEIT eingestellt werden!")
End If
End Sub
Sub SpinnerArbbeg()
z = 59 - DialogSheets("Arbeitsbeginn").DrawingObjects("spnArbbeg")
Worksheets("Tabelle2").Range("B1").Value = z
DialogSheets("Arbeitsbeginn").TextBoxes("txtArbbegmin").Text _
= Worksheets("Tabelle2").Range("B1").Value
End Sub
Sub ArbbegJa()
z = Worksheets("Tabelle2").Range("B1").Value
If jmin - z < 0 Then
jmin = 60 + (jmin - z): jstd = jstd - 1: If jstd < 0 Then jstd = 23
Else
jmin = jmin - z
End If
z = jstd & "," & Right$("00" + jmin, 2)
'MsgBox (heutezelle)
Worksheets("formular").Cells(heutezelle, 2).Value = z * 1
End Sub
Sub ArbeitsendeEintragen()
q = False
MonatszahlausMonat
m = monatszahl
j = Worksheets("formular").Range("H1").Value
MonatszahlErrechnen
For i = 7 To 7 + 30
t = i - 6
If t <= moza Then
MonatsnameErrechnen
If t = Day(Date) And m = Month(Date) And Int(j) = Year(Date) Then _
heutezelle = i: q = True
End If
Next i
If Worksheets("Tabelle2").Cells(heutezelle - 6, 8).Value = 0 Then
If q Then
jstd = Hour(Now)
jmin = Minute(Now)
zeit = jstd & ":" & Right$("00" + jmin, 2)
DialogSheets("Arbeitsende").TextBoxes("txtArbendezeit").Text = zeit
DialogSheets("Arbeitsende").TextBoxes("txtArbendemin").Text _
= Worksheets("Tabelle2").Range("B2").Value
DialogSheets("Arbeitsende").Show
Else
MsgBox ("Die Arbeitszeit kann nicht automatisch eingetragen" & _
Chr(13) & "werden, da das aktuelle Datum nicht auf dem aktiven" _
& Chr(13) & "Blatt zu finden ist!")
End If
Else
MsgBox ("Der Feldstatus dieses Tags muß erst auf ZEIT eingestellt werden!")
End If
End Sub
Sub SpinnerArbende()
z = 59 - DialogSheets("Arbeitsende").DrawingObjects("spnArbende")
Worksheets("Tabelle2").Range("B2").Value = z
DialogSheets("Arbeitsende").TextBoxes("txtArbendemin").Text _
= Worksheets("Tabelle2").Range("B2").Value
End Sub
Sub ArbendeJa()
z = Worksheets("Tabelle2").Range("B2").Value
If jmin + z > 59 Then
jmin = jmin + z - 60: jstd = jstd + 1: If jstd > 23 Then jstd = 0
Else
jmin = jmin + z
End If
z = jstd & "," & Right$("00" + jmin, 2)
'MsgBox (heutezelle)
Worksheets("formular").Cells(heutezelle, 4).Value = z * 1
End Sub
Sub Wochenzeit()
For i = 1 To 7
Worksheets("Tabelle2").Cells(i + 7, 3).Value = _
Worksheets("Tabelle2").Cells(i, 3).Value
Next i
DialogSheets("Wochenzeit").TextBoxes("txtwomo").Text _
= Worksheets("Tabelle2").Range("C1").Value / 10
DialogSheets("Wochenzeit").TextBoxes("txtwodi").Text _
= Worksheets("Tabelle2").Range("C2").Value / 10
DialogSheets("Wochenzeit").TextBoxes("txtwomi").Text _
= Worksheets("Tabelle2").Range("C3").Value / 10
DialogSheets("Wochenzeit").TextBoxes("txtwodo").Text _
= Worksheets("Tabelle2").Range("C4").Value / 10
DialogSheets("Wochenzeit").TextBoxes("txtwofr").Text _
= Worksheets("Tabelle2").Range("C5").Value / 10
DialogSheets("Wochenzeit").TextBoxes("txtwosa").Text _
= Worksheets("Tabelle2").Range("C6").Value / 10
DialogSheets("Wochenzeit").TextBoxes("txtwoso").Text _
= Worksheets("Tabelle2").Range("C7").Value / 10
DialogSheets("Wochenzeit").Show
Worksheets("Tabelle2").Range("D1").Value = monatszahl
Worksheets("Tabelle2").Range("D2").Value = Worksheets("formular").Range("H1").Value
Worksheets("tabelle2").Range("D3").Value = 1
End Sub
Sub spinnerwo1()
z = DialogSheets("Wochenzeit").DrawingObjects("spwo1").Value
Worksheets("Tabelle2").Range("C1").Value = z
DialogSheets("Wochenzeit").TextBoxes("txtwomo").Text _
= Worksheets("Tabelle2").Range("C1").Value / 10
End Sub
Sub spinnerwo2()
z = DialogSheets("Wochenzeit").DrawingObjects("spwo2")
Worksheets("Tabelle2").Range("C2").Value = z
DialogSheets("Wochenzeit").TextBoxes("txtwodi").Text _
= Worksheets("Tabelle2").Range("C2").Value / 10
End Sub
Sub spinnerwo3()
z = DialogSheets("Wochenzeit").DrawingObjects("spwo3")
Worksheets("Tabelle2").Range("C3").Value = z
DialogSheets("Wochenzeit").TextBoxes("txtwomi").Text _
= Worksheets("Tabelle2").Range("C3").Value / 10
End Sub
Sub spinnerwo4()
z = DialogSheets("Wochenzeit").DrawingObjects("spwo4")
Worksheets("Tabelle2").Range("C4").Value = z
DialogSheets("Wochenzeit").TextBoxes("txtwodo").Text _
= Worksheets("Tabelle2").Range("C4").Value / 10
End Sub
Sub spinnerwo5()
z = DialogSheets("Wochenzeit").DrawingObjects("spwo5")
Worksheets("Tabelle2").Range("C5").Value = z
DialogSheets("Wochenzeit").TextBoxes("txtwofr").Text _
= Worksheets("Tabelle2").Range("C5").Value / 10
End Sub
Sub spinnerwo6()
z = DialogSheets("Wochenzeit").DrawingObjects("spwo6")
Worksheets("Tabelle2").Range("C6").Value = z
DialogSheets("Wochenzeit").TextBoxes("txtwosa").Text _
= Worksheets("Tabelle2").Range("C6").Value / 10
End Sub
Sub spinnerwo7()
z = DialogSheets("Wochenzeit").DrawingObjects("spwo7")
Worksheets("Tabelle2").Range("C7").Value = z
DialogSheets("Wochenzeit").TextBoxes("txtwoso").Text _
= Worksheets("Tabelle2").Range("C7").Value / 10
End Sub
Sub woabbrechen()
For i = 1 To 7
Worksheets("Tabelle2").Cells(i, 3).Value = Worksheets("Tabelle2").Cells(i + 7, 3).Value
Next i
DialogSheets("Wochenzeit").Spinners("spwo1").Value _
= 239 - Worksheets("Tabelle2").Range("C1").Value
DialogSheets("Wochenzeit").Spinners("spwo2").Value _
= 239 - Worksheets("Tabelle2").Range("C2").Value
DialogSheets("Wochenzeit").Spinners("spwo3").Value _
= 239 - Worksheets("Tabelle2").Range("C3").Value
DialogSheets("Wochenzeit").Spinners("spwo4").Value _
= 239 - Worksheets("Tabelle2").Range("C4").Value
DialogSheets("Wochenzeit").Spinners("spwo5").Value _
= 239 - Worksheets("Tabelle2").Range("C5").Value
DialogSheets("Wochenzeit").Spinners("spwo6").Value _
= 239 - Worksheets("Tabelle2").Range("C6").Value
DialogSheets("Wochenzeit").Spinners("spwo7").Value _
= 239 - Worksheets("Tabelle2").Range("C7").Value
End Sub
Sub woeintragen()
MonatszahlausMonat
m = monatszahl
j = Worksheets("formular").Range("H1").Value
MonatszahlErrechnen
t = 1
MonatsnameErrechnen
x = wota
For i = 7 To 7 + 30
If x > 0 And Worksheets("formular").Cells(i, 1) <> Empty Then
Worksheets("formular").Cells(i, 10).Value = Worksheets("Tabelle2").Cells(x, 3).Value / 10
End If
x = x + 1
If x = 8 Then x = 1
Next i
Worksheets("formular").Unprotect
Worksheets("formular").DrawingObjects("Wochenzeit").Font.FontStyle = "standard"
Worksheets("formular").DrawingObjects("Wochenzeit").Font.ColorIndex = 1
Worksheets("formular").Protect
End Sub
Sub SollzeitspalteLöschen()
x = MsgBox("Wollen Sie die Sollzeit-Spalte" & Chr(13) & _
"wirklich löschen?" & Chr(13) & Chr(13) & "Kein Rückgängig!" _
& Chr(13), 260)
If x = 6 Then
For i = 7 To 7 + 30
Worksheets("formular").Cells(i, 10).Value = ""
Next i
Worksheets("formular").Unprotect
Worksheets("formular").DrawingObjects("Wochenzeit").Font.FontStyle = "Fett Kursiv"
Worksheets("formular").DrawingObjects("Wochenzeit").Font.ColorIndex = 3
Worksheets("formular").Protect
Worksheets("tabelle2").Range("d3") = 0
End If
End Sub
Sub Arbeitszeitspaltelöschen()
x = MsgBox("Wollen Sie die Spalten 'Arbeitsbeginn', 'Arbeitsende'" & Chr(13) & _
"und 'Fehlzeit' wirklich löschen?" & Chr(13) & _
"Der Feldstatus wird bei allen Tagen auf 'Zeit' gesetzt." _
& Chr(13) & Chr(13) & "Kein Rückgängig!" & Chr(13), 260)
If x = 6 Then
Worksheets("Formular").Unprotect
For i = 7 To 7 + 30
For j = 2 To 6 Step 2
Worksheets("Formular").Cells(i, j).Locked = False
Worksheets("formular").Cells(i, j).Value = ""
Next j
Worksheets("Formular").Cells(i, 2).NumberFormat = "0.00"
z = "B" & i
Worksheets("Formular").Cells(i, 3).Formula = _
"=int(" & z & ") +(int(((" & z & "-int(" & z & "))*100/6+0.001))/10)"
Worksheets("Formular").Cells(i, 8).Formula = _
"=IF(B" & i & ">0,IF(D" & i & ">B" & i & ",E" & i & "-C" & _
i & "-G" & i & ",),IF(G" & i & ">0,-G" & i & ",))"
If Worksheets("Tabelle2").Cells(i - 6, 8) = 3 Then
Worksheets("formular").Cells(i, 1).Font.ColorIndex = 1
End If
Worksheets("Tabelle2").Cells(i - 6, 8) = 0
Next i
Worksheets("formular").Protect
End If
End Sub
Sub druck()
Worksheets("formular").Unprotect
For j = 2 To 6 Step 2
For i = 7 To 7 + 30
Worksheets("Formular").Cells(i, j).Interior.ColorIndex = xlNone
Next i
Next j
For i = 7 To 7 + 30
Worksheets("Formular").Cells(i, 10).Interior.ColorIndex = xlNone
Next i
For i = 2 To 4
Worksheets("Formular").Cells(1, i).Interior.ColorIndex = xlNone
Next i
Sheets("Formular").Select
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1
For j = 2 To 6 Step 2
For i = 7 To 7 + 30
Worksheets("Formular").Cells(i, j).Interior.ColorIndex = 40
Next i
Next j
For i = 7 To 7 + 30
Worksheets("Formular").Cells(i, 10).Interior.ColorIndex = 40
Next i
For i = 2 To 4
Worksheets("Formular").Cells(1, i).Interior.ColorIndex = 40
Next i
Worksheets("formular").Protect
End Sub
Sub ende()
x = MsgBox("Soll das aktive Formular wirklich beendet werden?" & Chr(13) & _
"Es wird vorher gespeichert" _
& Chr(13), 4)
If x = 6 Then
'Application.OnSheetActivate = "!Modul1.test3"
Worksheets("formular").Unprotect
Worksheets("formular").DrawingObjects("WotaEintragen").Font.FontStyle = "Fett Kursiv"
Worksheets("formular").DrawingObjects("WotaEintragen").Font.ColorIndex = 3
Worksheets("formular").Protect
With ActiveWindow
.DisplayHorizontalScrollBar = True
.DisplayWorkbookTabs = True
End With
With Application
.DisplayFormulaBar = True
.DisplayStatusBar = True
End With
Toolbars(1).Visible = True
Toolbars(2).Visible = True
Toolbars(7).Visible = False
With Application
.ShowToolTips = True
.LargeButtons = False
.ColorButtons = True
End With
Worksheets("Tabelle2").Range("D1").Value = monatszahl
Worksheets("Tabelle2").Range("D2").Value = Worksheets("formular").Range("H1").Value
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
End Sub
Sub statÜs()
adr = ActiveWindow.RangeSelection.Address
'MsgBox (adr)
If Len(adr) <= 5 Then
adr1 = Right(Left(adr, 2), 1)
adr2 = Right(adr, Len(adr) - 3)
If adr1 = "B" And adr2 >= 7 And adr2 <= 37 Then
If Worksheets("Formular").Cells(adr2, 10).Value = 0 Then
MsgBox ("Der Status dieses Felds kann nicht geändert werden," & Chr$(13) & _
"da keine SOLLZEIT für diesen Tag eingetragen wurde!" & Chr$(13) & Chr$(13) & _
"Klicken Sie dazu auf 'Rahmenzeit festlegen' oder" & Chr$(13) & _
"geben Sie die Sollzeit für diesen Tag manuell ein!")
Else
x = Worksheets("Tabelle2").Cells(adr2 - 6, 8).Value
If x = 0 Then
DialogSheets("Status").TextBoxes("txtstat").Text = "Zeit"
End If
If x = 1 Then
DialogSheets("Status").TextBoxes("txtstat").Text = "krank"
End If
If x = 2 Then
DialogSheets("Status").TextBoxes("txtstat").Text = "Urlaub"
End If
If x = 3 Then
DialogSheets("Status").TextBoxes("txtstat").Text = "Feiertag"
End If
If x = 4 Then
DialogSheets("Status").TextBoxes("txtstat").Text = "ÜS Abbau"
End If
If x = 5 Then
DialogSheets("Status").TextBoxes("txtstat").Text = "Freier Text"
End If
DialogSheets("ÜStd").TextBoxes("txtÜstd").Text = _
Abs((Worksheets("Formular").Cells(adr2, 10).Value)) - 0.5
DialogSheets("ÜStd").DrawingObjects("spnÜstd").Value = _
Abs(((Worksheets("Formular").Cells(adr2, 10).Value)) - 0.5) * 10
w = Left(Worksheets("Formular").Cells(adr2, 1).Value, 2) & ", den" & _
Right(Worksheets("Formular").Cells(adr2, 1).Value, Len(Worksheets("Formular").Cells(adr2, 1).Value) - 3) & " " & _
Worksheets("Formular").Range("G1").Value & " " & _
Worksheets("Formular").Range("H1").Value
DialogSheets("Status").TextBoxes("txttag").Text = w
DialogSheets("Status").Show
End If
Else
MsgBox ("Klicken Sie in eine der Zellen 'Arbeitsbeginn'")
End If
Else
MsgBox ("Klicken Sie in EINE der Zellen 'Arbeitsbeginn'")
End If
End Sub
Sub Statuszeit()
Worksheets("formular").Unprotect
Worksheets("Formular").Cells(adr2, 2).NumberFormat = "0.00"
Worksheets("Formular").Cells(adr2, 2).Font.Size = 10
Worksheets("Formular").Cells(adr2, 2).Value = ""
Worksheets("Formular").Cells(adr2, 6).Value = ""
Worksheets("Formular").Cells(adr2, 2).Locked = False
Worksheets("Formular").Cells(adr2, 4).Locked = False
Worksheets("Formular").Cells(adr2, 6).Locked = False
z = adr1 & adr2
Worksheets("Formular").Cells(adr2, 3).Formula = _
"=int(" & z & ") +(int(((" & z & "-int(" & z & "))*100/6+0.001))/10)"
Worksheets("Formular").Cells(adr2, 8).Formula = _
"=IF(B" & adr2 & ">0,IF(D" & adr2 & ">B" & adr2 & ",E" & adr2 & "-C" & _
adr2 & "-G" & adr2 & ",),IF(G" & adr2 & ">0,-G" & adr2 & ",))"
Worksheets("formular").Cells(adr2, 1).Font.ColorIndex = 1
Worksheets("formular").Protect
Worksheets("Tabelle2").Cells(adr2 - 6, 8) = 0
KrankUrlaubchecken
End Sub
Sub Statusurlaub()
x = MsgBox("Wenn Sie das Feld auf 'Urlaub' stellen," & Chr(13) & _
"werden an diesem Tag evtl. eingetragene Arbeitszeiten gelöscht." & Chr(13) & Chr(13) _
& "Wollen Sie das wirklich?" & Chr(13), 260)
If x = 6 Then
Worksheets("formular").Unprotect
Worksheets("Formular").Cells(adr2, 2).Value = "Urlaub"
Worksheets("Formular").Cells(adr2, 2).Font.Size = 10
Worksheets("Formular").Cells(adr2, 8).Formula = _
"=IF(B" & adr2 & ">0,IF(D" & adr2 & ">B" & adr2 & ",E" & adr2 & "-C" & _
adr2 & "-G" & adr2 & ",),IF(G" & adr2 & ">0,-G" & adr2 & ",))"
Worksheets("Formular").Cells(adr2, 2).Locked = True
Worksheets("Formular").Cells(adr2, 4).Locked = True
Worksheets("Formular").Cells(adr2, 6).Locked = True
Worksheets("Formular").Cells(adr2, 3).Value = 0
Worksheets("Formular").Cells(adr2, 4).Value = ""
Worksheets("Formular").Cells(adr2, 6).Value = ""
Worksheets("formular").Cells(adr2, 1).Font.ColorIndex = 1
Worksheets("formular").Protect
Worksheets("Tabelle2").Cells(adr2 - 6, 8) = 2
KrankUrlaubchecken
End If ' x=6
DialogSheets("Status").Hide
End Sub
Sub Statuskrank()
x = MsgBox("Wenn Sie das Feld auf 'krank' stellen," & Chr(13) & _
"werden an diesem Tag evtl. eingetragene Arbeitszeiten gelöscht." & Chr(13) & Chr(13) _
& "Wollen Sie das wirklich?" & Chr(13), 260)
If x = 6 Then
Worksheets("formular").Unprotect
Worksheets("Formular").Cells(adr2, 2).Value = "krank"
Worksheets("Formular").Cells(adr2, 2).Font.Size = 10
Worksheets("Formular").Cells(adr2, 8).Formula = _
"=IF(B" & adr2 & ">0,IF(D" & adr2 & ">B" & adr2 & ",E" & adr2 & "-C" & _
adr2 & "-G" & adr2 & ",),IF(G" & adr2 & ">0,-G" & adr2 & ",))"
Worksheets("Formular").Cells(adr2, 2).Locked = True
Worksheets("Formular").Cells(adr2, 4).Locked = True
Worksheets("Formular").Cells(adr2, 6).Locked = True
Worksheets("Formular").Cells(adr2, 3).Value = 0
Worksheets("Formular").Cells(adr2, 4).Value = ""
Worksheets("Formular").Cells(adr2, 6).Value = ""
Worksheets("formular").Cells(adr2, 1).Font.ColorIndex = 1
Worksheets("formular").Protect
Worksheets("Tabelle2").Cells(adr2 - 6, 8) = 1
KrankUrlaubchecken
End If
DialogSheets("Status").Hide
End Sub
Sub Statusfeiertag()
x = MsgBox("Wenn Sie das Feld auf 'Feiertag' stellen," & Chr(13) & _
"werden an diesem Tag evtl. eingetragene Arbeitszeiten gelöscht." & Chr(13) & Chr(13) _
& "Wollen Sie das wirklich?" & Chr(13), 260)
If x = 6 Then
Worksheets("formular").Unprotect
Worksheets("Formular").Cells(adr2, 2).Value = "Feiertag"
Worksheets("Formular").Cells(adr2, 2).Font.Size = 10
Worksheets("Formular").Cells(adr2, 8).Formula = _
"=IF(B" & adr2 & ">0,IF(D" & adr2 & ">B" & adr2 & ",E" & adr2 & "-C" & _
adr2 & "-G" & adr2 & ",),IF(G" & adr2 & ">0,-G" & adr2 & ",))"
Worksheets("Formular").Cells(adr2, 2).Locked = True
Worksheets("Formular").Cells(adr2, 4).Locked = True
Worksheets("Formular").Cells(adr2, 6).Locked = True
Worksheets("Formular").Cells(adr2, 3).Value = 0
Worksheets("Formular").Cells(adr2, 4).Value = ""
Worksheets("Formular").Cells(adr2, 6).Value = ""
Worksheets("formular").Cells(adr2, 1).Font.ColorIndex = 3
Worksheets("formular").Protect
Worksheets("Tabelle2").Cells(adr2 - 6, 8) = 3
KrankUrlaubchecken
End If
DialogSheets("Status").Hide
End Sub
Sub statÜbstd()
DialogSheets("Status").Hide
DialogSheets("ÜStd").Show
End Sub
Sub Freitext()
y = 0
DialogSheets("Status").Hide
x = Application.InputBox("Geben Sie für diesen Tag einen freien Text" & Chr$(13) _
& "ein, z. B. 'geschwänzt' oder 'hitzefrei' o. ä." & Chr$(13) & _
"oder warum man sonst an diesem Tag nicht gearbeitet hat." & Chr$(13) & Chr$(13) & _
"Der Text darf nicht länger sein als ein kurzes Wort!", "Freitext eingeben", , , , , , 2)
If x <> False Then
Worksheets("formular").Unprotect
Worksheets("Formular").Cells(adr2, 2).Value = x
Worksheets("Formular").Cells(adr2, 2).Font.Size = 9
Worksheets("Formular").Cells(adr2, 8).Formula = _
"=IF(B" & adr2 & ">0,IF(D" & adr2 & ">B" & adr2 & ",E" & adr2 & "-C" & _
adr2 & "-G" & adr2 & ",),IF(G" & adr2 & ">0,-G" & adr2 & ",))"
Worksheets("Formular").Cells(adr2, 2).Locked = True
Worksheets("Formular").Cells(adr2, 4).Locked = True
Worksheets("Formular").Cells(adr2, 6).Locked = True
Worksheets("Formular").Cells(adr2, 3).Value = 0
Worksheets("Formular").Cells(adr2, 4).Value = ""
Worksheets("Formular").Cells(adr2, 6).Value = ""
Worksheets("formular").Protect
Worksheets("Tabelle2").Cells(adr2 - 6, 8) = 5
KrankUrlaubchecken
End If
End Sub
Sub StatusUeberstunden()
Worksheets("formular").Unprotect
y = DialogSheets("ÜStd").DrawingObjects("spnÜstd").Value / 10
y1 = Fix(y)
y2 = Abs(y) - y1
Worksheets("Formular").Cells(adr2, 6).Value = y1 + y2 * 0.6
Worksheets("Formular").Cells(adr2, 2).Value = "ÜS-Abbau"
Worksheets("Formular").Cells(adr2, 8).Formula = _
"=E" & adr2 & "-C" & adr2 & "-G" & adr2 & ""
Worksheets("Formular").Cells(adr2, 2).Locked = True
Worksheets("Formular").Cells(adr2, 4).Locked = True
Worksheets("Formular").Cells(adr2, 6).Locked = False
Worksheets("Formular").Cells(adr2, 3).Value = 0
Worksheets("Formular").Cells(adr2, 4).Value = ""
Worksheets("formular").Cells(adr2, 1).Font.ColorIndex = 1
Worksheets("formular").Protect
Worksheets("Tabelle2").Cells(adr2 - 6, 8) = 4
DialogSheets("ÜStd").Hide
KrankUrlaubchecken
End Sub
Sub Statusabbruch()
DialogSheets("Status").Hide
End Sub
Sub Nameeintragen()
y = Worksheets("Formular").Range("B1").Value
x = Application.InputBox("Geben Sie Ihren Namen ein:", "Name eingeben", y, , , , , 2)
If x <> False Then
Worksheets("formular").Unprotect
Worksheets("Formular").Range("B1").Value = x
Worksheets("formular").Protect
End If
End Sub
Sub statüstd()
z = DialogSheets("ÜStd").DrawingObjects("spnÜstd").Value
DialogSheets("ÜStd").TextBoxes("txtÜstd").Text = _
DialogSheets("ÜStd").DrawingObjects("spnÜstd").Value / 10
End Sub
Sub KrankUrlaubchecken()
x = 0
For i = 7 To 7 + 30
If Worksheets("formular").Cells(i, 2).Value = "Urlaub" Then x = x + 1
Next i
Worksheets("formular").Range("E43").Value = x
x = 0
For i = 7 To 7 + 30
If Worksheets("formular").Cells(i, 2).Value = "krank" Then x = x + 1
Next i
Worksheets("formular").Range("C43").Value = x
End Sub