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

Предупреждение о сроке действия документа за N дней

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

Public Function DocExpiryAlarm(vDocDate, Optional iExpiryMonths% = 6, Optional iDaysBefore% = 20) As Integer
'Предупреждение о сроке действия документа за N дней
'Функция возвращает следующие значения:
'   0 =  Документ действует
'   1 =  Предупреждение о скором окончании срока действия
'  -1 =  Документ просрочен
'---------------------------------------------------------------------------------------------------
' Аргументы:
'   vDocDate       = Дата выдачи документа
'   iExpiryMonths  = Срок действия месяцев (тут по умолчанию = 6)
'   iDaysBefore    = Количество дней до истечения слока вкл. предупреждения (тут по умолчанию = 20)
'---------------------------------------------------------------------------------------------------
Dim dExpiryDate As Date
Dim iVal%
On Error GoTo DocExpiryAlarm_Err
    dExpiryDate = DateAdd("m", iExpiryMonths, vDocDate)
    iVal = DateDiff("d", Date, dExpiryDate)
    Select Case iVal
        Case Is > iDaysBefore:   DocExpiryAlarm = 0  ' Документ Действует = ОК
        Case 0 To iDaysBefore:   DocExpiryAlarm = 1  ' Осталось N последних дней из iDaysBefore
        Case Is < 0:             DocExpiryAlarm = -1 ' Просрочен !!!
    End Select

DocExpiryAlarm_End:
    Exit Function

DocExpiryAlarm_Err:
    Err.Clear
    DocExpiryAlarm = -1
    Resume DocExpiryAlarm_End
End Function


Проверка:

Dim dDate As Date
    dDate = DateAdd("m", -6, Date) 'Ровно полгода назад
    Debug.Print "Выдана: " & dDate & "  Истекает: " & DateAdd("m", 6, dDate) & _
        " - Осталость дней:" & DateDiff("d", Date, DateAdd("m", 6, dDate)) & " DocExpiryAlarm = " & DocExpiryAlarm(dDate)
    
    dDate = dDate - 3             'полгода и 3 дня назад
    Debug.Print "Выдана: " & dDate & "  Истекает: " & DateAdd("m", 6, dDate) & _
        " - Осталость дней:" & DateDiff("d", Date, DateAdd("m", 6, dDate)) & " DocExpiryAlarm = " & DocExpiryAlarm(dDate)
     
    dDate = DateAdd("m", -4, Date) 'ровно 4 месяца назад
    Debug.Print "Выдана: " & dDate & "  Истекает: " & DateAdd("m", 6, dDate) & _
        " - Осталость дней:" & DateDiff("d", Date, DateAdd("m", 6, dDate)) & " DocExpiryAlarm = " & DocExpiryAlarm(dDate)


Запрос:

SELECT фио.*, DateDiff("d",Date(), DateAdd("m",6,[Дата справки])) AS ОсталосьД, 
    DocExpiryAlarm([Дата справки]) AS Статус
FROM фио;



Или в поле формы пишите источник данных :

= DocExpiryAlarm([Дата справки];6; 14)

Формат поля задаёте например такой:
https://learn.microsoft.com/ru-ru/office/vba/api/access.format.propertynumber.and.currency

"Внимание!"[Blue];"Просроченj !!!"[Red];" - ";" - "

Picture




Скачать

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


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