Вхождение диапазона действия (документа) по ДатеНачала и ДатеОкончания в диапазон отбораПо материалам: 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 MSA-2007 и выше ( 44 kB) Пример |
|||
L.E. 13.06.2023 |