| "Autor" |
|
|
|
|
geschrieben am: 11.05.2002 um 15:34 Uhr
|
|
(zitat)VBA-Bibliothek: Rechnen mit Werk- und Arbeitstagen
Hier ne kleine Hilfe für Access und Werk und Arbeitstage Berechnung
Function IstWerktag(dtTag As Variant) As Boolean
dtTag = CDate(dtTag) 'Strings ggf. nach Date konvertieren
IstWerktag = (WeekDay(dtTag) <> vbSunday And WeekDay(dtTag) <> vbSaturday)
End Function
Function IstWochenende(dtTag As Variant) As Boolean
dtTag = CDate(dtTag) 'Strings ggf. nach Date konvertieren
IstWochenende = (WeekDay(dtTag) = vbSunday Or WeekDay(dtTag) = vbSaturday)
End Function
Function IstArbeitstag(dtTag As Variant) As Boolean
Dim db As Database
Dim rs As Recordset
Dim strSQL As String
Dim sngFeiertage As Single
dtTag = CDate(dtTag) 'Strings ggf. nach Date konvertieren
'Wochenende prüfen - wenn ja, gleich wieder raus...
If WeekDay(dtTag) = vbSunday Or WeekDay(dtTag) = vbSaturday Then
IstArbeitstag = False
Exit Function
End If
'Ansonsten weitere Prüfungen anhand Tabelle 'Feiertage'
Set db = CurrentDb()
strSQL = "select distinctrow Sum([FTFaktor]) AS [AnzFeiertage] from Feiertage "
strSQL = strSQL & "where [FTDatum] = #" & Format$(dtTag, "mm-dd-yyyy") & "#"
Set rs = db.OpenRecordset(strSQL)
On Error Resume Next
sngFeiertage = rs("AnzFeiertage")
If Err <> 0 Then 'Nichts gefunden
IstArbeitstag = True
Else
IstArbeitstag = False
End If
rs.Close
End Function
Function AnzahlWerktage(dtVon As Variant, dtBis As Variant) As Long
Dim dtErsterTag As Date
Dim dtLetzterTag As Date
Dim dtTempDatum As Date
Dim lngAnzTage As Long
Dim intVorZurueck As Integer
'Strings ggf. nach Date konvertieren...
dtVon = CDate(dtVon)
dtBis = CDate(dtBis)
'Ersten und letzten Tag, Flag für vor-/rückwärts setzen...
If dtVon < dtBis Then
dtErsterTag = dtVon
dtLetzterTag = dtBis
intVorZurueck = 1
Else
dtErsterTag = dtBis
dtLetzterTag = dtVon
intVorZurueck = -1
End If
'Anzahl Tage Brutto ermitteln...
lngAnzTage = DateDiff("d", dtErsterTag, dtLetzterTag) + 1
'Davon die Wochenenden Sa/So abziehen...
dtTempDatum = CDate(dtErsterTag)
While dtTempDatum <= dtLetzterTag
'Sa/So ggf. ausklammern...
If WeekDay(dtTempDatum) = vbSunday Or WeekDay(dtTempDatum) = vbSaturday Then
lngAnzTage = lngAnzTage - 1
End If
dtTempDatum = dtTempDatum + 1
Wend
'Funktionsergebnis setzen...
AnzahlWerktage = intVorZurueck * lngAnzTage
Abschließend setzen wir das Funktionsergebnis unter Berücksichtigung des »Vorwärts/Rückwärts«-Kennzeichens.
Die Funktion »AnzahlArbeitstage()«
Function AnzahlArbeitstage(dtVon As Variant, dtBis As Variant) As Single
Dim db As Database
Dim rs As Recordset
Dim strSQL As String
Dim sngWerktageGesamt As Single
Dim sngFeiertage As Single
'Strings ggf. nach Date konvertieren...
dtVon = CDate(dtVon)
dtBis = CDate(dtBis)
'Anzahl Werktage gesamt ermitteln...
sngWerktageGesamt = AnzahlWerktage(dtVon, dtBis)
'Davon Feiertage abziehen...
Set db = CurrentDb()
strSQL = "select distinctrow Sum([FTFaktor]) AS [AnzFeiertage] from Feiertage "
If dtVon <= dtBis Then
strSQL = strSQL & "where [FTDatum] >= #" & Format$(dtVon, "mm-dd-yyyy") & _
"# And [FTDatum] <= #" & Format$(dtBis, "mm-dd-yyyy") & "#"
Else
strSQL = strSQL & "where [FTDatum] >= #" & Format$(dtBis, "mm-dd-yyyy") & _
"# And [FTDatum] <= #" & Format$(dtVon, "mm-dd-yyyy") & "#"
End If
On Error Resume Next
Set rs = db.OpenRecordset(strSQL)
If Err = 0 Then
sngFeiertage = rs("AnzFeiertage")
Else
sngFeiertage = 0
End If
rs.Close
AnzahlArbeitstage = sngWerktageGesamt ? sngFeiertage
Urlaubstermine prüfen
Sub UrlaubPruefen(dtVon As Date, dtBis As Date, intResturlaub As Integer)
Dim intArbeitstage As Integer
Dim strMsg As String
intArbeitstage = AnzahlArbeitstage("15.11.2000", "8.12.2000")
strMsg = "Anzahl Arbeitstage vom " & dtVon & " bis " & dtBis & ": " & _
CStr(intWerktage) & vbCrLf & vbCrLf
If intArbeitstage > intResturlaub Then
strMsg = strMsg & "!!! Nicht genug Resturlaub !!!"
Else
strMsg = strMsg & "Urlaub OK..."
End If
MsgBox strMsg, vbOKOnly + vbInformation, "Urlaub prüfen:"
End Sub
Aja..... 
(ist doch mehr als einfach oder)
mfg Doggy(/zitat) |
|
|
|
|
|
|
Top
|
