Anbei das Makro
06.04.2021 15:12:31
sigrid
Hallo,
das steht für Jan z.B. 01, Februar 02, Zahlenformat ist "00"
Public Sub Arbeitszeiten_eintragen()
Dim iMonat As Integer
Dim iJahr As Integer
Dim iUltimo As Integer
Dim lZeile As Long
Dim dDatum As Date
Dim lVormonat As Long
Dim datDatum As Date '6.4.21
ActiveSheet.Unprotect (getStrPasswort)
With ActiveSheet
'ThisWorkbook.Worksheets("Tabelle3") ' den Tabellenblatrtnamen ggf. anpassen
ActiveSheet.Unprotect (getStrPasswort)
iJahr = Val(.Range("N2").Value)
iMonat = Val(.Range("I3").Value)
datDatum = DateSerial(.Range("i3"), .Range("I3"), 1) '6.4.21
MsgBox FormatC "MMM YY") '6.4.21
' den letzten Tag des angeforderten Monats ermitteln
iUltimo = Day(DateSerial(Val(iJahr), iMonat + 1, 0))
' die Krankheits- und die Zeit-Spalten leeren
.Range("D14:G44").ClearContents
' die Datumszeilen abarbeiten + 13, weil ab Spalte 14 begonnen wird
For lZeile = 14 To iUltimo + 13
ActiveSheet.Unprotect (getStrPasswort)
Select Case Weekday(CDate(.Range("C" & lZeile).Value), 2)
Case 1 To 4 ' Montag - Donnerstag
.Range("E" & lZeile).Value = ActiveSheet.Range("R2") '"0800" ' "08: _
00"
.Range("F" & lZeile).Value = ActiveSheet.Range("Q2") '"0030" ' "00: _
30"
.Range("G" & lZeile).Value = ActiveSheet.Range("S2") '"1700" ' "17: _
00"
.Unprotect (getStrPasswort)
.Range("C" & lZeile).Font.ColorIndex = 1 '1
Case 5 ' Freitag
.Range("E" & lZeile).Value = ActiveSheet.Range("R2") '"0800" ' "08: _
00"
.Range("F" & lZeile).Value = ActiveSheet.Range("Q2") '"0030" ' "00: _
30"
.Range("G" & lZeile).Value = ActiveSheet.Range("T2") '"1430" ' "14: _
30"
.Unprotect (getStrPasswort)
.Range("C" & lZeile).Font.ColorIndex = 1 '1
Case Else
.Range("E" & lZeile & ":G" & lZeile).ClearContents
End Select
If Feiertage_holen(CDate(.Range("C" & lZeile).Value)) = True Then
.Range("D" & lZeile).Value = "F"
.Unprotect (getStrPasswort)
.Range("C" & lZeile).Font.ColorIndex = 3
.Range("E" & lZeile & ":I" & lZeile).ClearContents
End If
dDatum = CDate(.Range("C14").Value) ' Ultimo des Vormonats
For lVormonat = 10 To 5 Step -1 'hier Änderung jetzt wird ab H5 _
Datum eingetragen
Do
dDatum = dDatum - 1
Loop Until Feiertage_holen(dDatum) = False And _
Weekday(dDatum, 2)
gruß sigrid