Option Explicit
Dim mvarExceptions 'массив праздничных дней из таблицы праздников
Public Function fondwt(datafrom As Date, datato As Date)
'фонд рабочего времени за месяц в промежутке которого дата исходя что рабочий день 8ч
call LoadExceptions(datafrom) ' изначально расчитано на месяц - если другие условия - переделать
Dim data1 As Date
For data1 = datafrom To datato
If Not IsException(data1) Then fondwt = fondwt + 8
Next data1
End Function
Function IsException(D) As Boolean
Dim i As Integer
Dim DayWeek As Single
DayWeek = DatePart("w", D, vbUseSystem) 'vbUseSystem 0 Use the NLS API setting.
IsException = DayWeek = 6 Or DayWeek = 7
If IsEmpty(mvarExceptions) Then Exit Function
For i = 0 To UBound(mvarExceptions, 2)
If D = mvarExceptions(0, i) Then
IsException = Not IsException
Exit For
End If
If D < mvarExceptions(0, i) Then Exit For 'т.к. Даты в массиве по порядку
Next
End Function
Sub LoadExceptions(D As Variant)
'D - дата внутри месяца, для которого загружается в массив список праздников - если надо по неопределенному периоду а не по месяцу то убрать условие отбора
On Error Resume Next
mvarExceptions = CurrentProject.Connection.Execute("SELECT dExcept FROM tblExceptions where month(dExcept) = " & Month(D) & " and year(dExcept) = " & Year(D) & " order by dExcept ").GetRows
End Sub
|