VBA, MS Access MS Access в примерах

Вхождение диапазона действия (документа) по ДатеНачала и ДатеОкончания в диапазон отбора

По материалам: https://www.cyberforum.ru/ms-access/thread3115132.html

В запросе:


    ... WHERE ([Дата Начала] <= [FilterEnd]) And ([Дата Окончания] >= [FilterStart])


Функция "индикатор вхождения":

Public Function DocInDateRange(vRangeStart, vRangeEnd, vDateStart, vDateEnd) As Boolean
' es - 09.02.2020 LE 14.06.2023 v003 - Индикатор вхождения
' Вхождение диапазона действия (документа) по ДатеНачала и ДатеОкончания в диапазон дат отбора
' Возвращает: True | False
'---------------------------------------------------------------------------------------------------
'   ... WHERE (([Дата Начала] <= [FilterEnd]) And ([Дата Окончания] >= [FilterStart]))
'---------------------------------------------------------------------------------------------------
' Аргументы:
'   vRangeStart      = Дата начала диапазона отбора
'   vRangeEnd        = Дата окончания диапазона отбора
'   vDateStart       = Дата начала действия документа
'   vDateEnd         = Дата окончания действия документа
'---------------------------------------------------------------------------------------------------
Const lNoValueEnd As Long = 999999 ' 999999 = 25.11.4637 !
Dim dRangeStart As Date, dRangeEnd As Date, dStart As Date, dEnd As Date, vVal
'---------------------------------------------------------------------------------------------------
On Error GoTo DocInDateRange_Err

' Опционально: Если диапазон отбора не задан
    'If IsNull(vRangeStart) And IsNull(vRangeEnd) Then GoTo DocInDateRange_End
' Опционально: Если Дата начала действия документа и Дата окончания не заданы!
    'If IsNull(vDateStart) And IsNull(vDateEnd) Then GoTo DocInDateRange_End
    
    dRangeStart = Nz(vRangeStart, 0)
    dRangeEnd = Nz(vRangeEnd, lNoValueEnd)
    
' Проверка на Старт после Финиша в фильтре! = меняем местами - иначе "не взлетит"!
    If dRangeStart > dRangeEnd Then
        vVal = dRangeStart
        dRangeStart = dRangeEnd
        dRangeEnd = vVal
    End If
    
    dStart = Nz(vDateStart, 0)
    dEnd = Nz(vDateEnd, lNoValueEnd)
    
    DocInDateRange = (dStart <= dRangeEnd) And (dEnd >= dRangeStart)
'---------------------------------------------------------------------------------------------------
DocInDateRange_End:
    Exit Function
 
DocInDateRange_Err:
    Err.Clear
    Resume DocInDateRange_End
End Function

Picture




Скачать

MSA-2007 и выше ( 44 kB) Пример


Назад ToTop
L.E. 13.06.2023
Рейтинг@Mail.ru