AW: VBA Monatsanfang
30.06.2006 10:49:45
fcs
Hallo Stefan,
das kann man mit einem Workbook_Open Makro umsetzen
Im folgenden Beispiel wird der 1. Arbeitstag im Monat mit einer Function bestimmt und mit dem aktuellen Tage verglichen.
mfg
Franz
Im VBA-Editor Unter "DieseArbeitsmappe":
Private Sub Workbook_Open()
'Vergleich des 1. Arbeitstages im Monat mit dem aktuellen Datum
November = True '1. November ist Feiertag
If Date = ErsterArbeitstag(Date, November) Then
If MsgBox("Heute ist der 1. Arbeitstag im Monat!" & vbLf & vbLf & _
"Soll die alte Statistik gelöscht werden?", vbQuestion + vbYesNo) = vbYes Then
Call löschenStatistik
End If
End If
End Sub
In ein Modul, das Löschen-Makro hab ich ein wenig optimiert:
Sub löschenStatistik()
' Löschen der alten Statistik-Daten
With Sheets("Statistik")
.Unprotect
.Columns("A:I").Clear
.Columns("K:K").ClearContents
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
End Sub
Function ErsterArbeitstag(Datum As Date, Optional ByVal November As Boolean) As Date
'Bestimmung des 1. Arbeitstages im Monat des Datum
' Datum = DateSerial(2006, 6, 1) 'Testzeile
Select Case Month(Datum)
Case 1, 5 'Feiertag 1. Jan + 1. Mai
ErsterArbeitstag = Feiertag1(Datum)
Case 10 'Feiertag 3. Oktober
ErsterArbeitstag = Feiertag3(Datum)
Case 11 'Feiertag 1. November (regional)
If November = True Then
ErsterArbeitstag = Feiertag1(Datum)
Else
ErsterArbeitstag = KeinFeiertag1(Datum)
End If
Case 2, 3, 4, 6, 7, 8, 9, 12 'Standardmonate
ErsterArbeitstag = KeinFeiertag1(Datum)
Case Else
'do nothing
End Select
End Function
Private Function Feiertag1(Datum As Date) As Date
'1. Arbeitstag, wenn der 1. des Monats ein Feiertag ist
Select Case WeekDay(Datum)
Case vbFriday
Feiertag1 = DateSerial(Year(Datum), Month(Datum), 4)
Case vbSaturday
Feiertag1 = DateSerial(Year(Datum), Month(Datum), 3)
Case Else
Feiertag1 = DateSerial(Year(Datum), Month(Datum), 2)
End Select
End Function
Private Function Feiertag3(Datum As Date) As Date
'1. Arbeitstag, wenn der 3. des Monats ein Feiertag ist
Select Case WeekDay(Datum)
Case vbSaturday
Feiertag3 = DateSerial(Year(Datum), Month(Datum), 4)
Case vbSunday
Feiertag3 = DateSerial(Year(Datum), Month(Datum), 2)
Case Else
Feiertag3 = DateSerial(Year(Datum), Month(Datum), 1)
End Select
End Function
Private Function KeinFeiertag1(Datum As Date) As Date
'1. Arbeitstag, wenn der 1. des Monats kein Feiertag ist
Select Case WeekDay(Datum)
Case vbSaturday
KeinFeiertag1 = DateSerial(Year(Datum), Month(Datum), 3)
Case vbSunday
KeinFeiertag1 = DateSerial(Year(Datum), Month(Datum), 2)
Case Else
KeinFeiertag1 = DateSerial(Year(Datum), Month(Datum), 1)
End Select
End Function