Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Access
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 31.07.2019, 13:45   #1
HMMWV
Новичок
Джуниор
 
Регистрация: 12.06.2019
Сообщений: 2
По умолчанию Код VBA для просчета даты

Всем привет!

Подскажите код VBA. У меня на форме есть объект ПолеСоСписком40, в котором содержится информация о периодичности получения продуктов (Ежемесячно, Раз в три месяца, Раз в пол года и т.д.); объект Поле с датой получения продуктов; объект Поле с датой следующего получения.

Мне нужно сделать так, чтобы при выборе Ежемесячного получения, в поле Следующая выдача было Дата Получения+30. Меняем Ежемесячное на Раз в три месяца и получаем Следующая выдача=Дата Получения+90

Еще нужна проверка на периодичность получения. Например, если Текущая дата – Дата получения>210, то Флажок Архив=true

Скриншот 31-07-2019 12.06.51.png

Последний раз редактировалось HMMWV; 31.07.2019 в 13:49. Причина: Случайно нажал отправить
HMMWV вне форума Ответить с цитированием
Старый 15.10.2019, 11:03   #2
Eugene-LS
Пользователь
 
Аватар для Eugene-LS
 
Регистрация: 23.02.2018
Сообщений: 78
По умолчанию

Кодом батенька - кодом!

Например:
Код:
Private Sub Form_Load()
    cbxSrDatesAuto_Build 'Построение списка
End Sub
Private Sub cbxSrDatesAuto_Build()
'Построение списка комбобокса Авто-Диапазона Дат:
Dim iYear%, iMonth%, dLastMonthEnd As Date
Dim s$
    
'Это пригодится при расчётах:
    iYear = Year(Date)
    iMonth = Month(Date)

    dLastMonthEnd = DateSerial(iYear, iMonth, 0) 'последние число прошлого месяца
    'Debug.Print dLastMonthEnd
    
'Составление строки RS     '"12;'НГ - Конец тек. мес.';" & _'
    s = "11;'Текущий месяц - " & Format(iMonth, "00") & "." & iYear & "';" & _
        "13;'Прошлый месяц - " & Format(Month(dLastMonthEnd), "00") & "." & Year(dLastMonthEnd) & "';" & _
        "12;'Позапрошлый месяц - " & Format(iMonth - 2, "00") & "." & Year(dLastMonthEnd) & "';" & _
        "21;'1 Квартал - " & iYear & "г.';" & _
        "22;'2 Квартал - " & iYear & "г.';" & _
        "23;'3 Квартал - " & iYear & "г.';" & _
        "24;'4 Квартал - " & iYear & "г.';" & _
        "31;'1е Полугодие - " & iYear & "г.';" & _
        "32;'2е Полугодие - " & iYear & "г.';" & _
        "41;'9 Месяцев - " & iYear & "г.';" & _
        "42;'9 Месяцев - " & iYear - 1 & "г.';" & _
        "51;'Текущий - " & iYear & "г.';" & _
        "52;'Прошлый - " & iYear - 1 & "г.';" & _
        "99;'<<< Очистить поля дат !!!'"
    Me!cbxSrDatesAuto.RowSource = s
    
End Sub
Потом:

Код:
Private Sub cbxSrDatesAuto_AfterUpdate()
'Задаём диапазон дат:
Dim iYear%, iMonth%, dFirstDY As Date, dTemp As Date, vStart, vEnd
Dim iVal As Integer
Dim sSQL As String

'----------------------------------------------------------------
'Зачистка фильтра
    cmdFilterClear_Click


    If Me!cbxSrDatesAuto.ListIndex = -1 Then
        'Зачистка от возможных прежних данных
        sSQL = "DELETE FROM tp_AIR_Report"
        CurrentDb.Execute sSQL

        sSQL = "DELETE FROM tp_AIR_Report_Participants"
        CurrentDb.Execute sSQL
        DoEvents
        
        Me!txtSrDataFrom = Null
        Me!txtSrDataTo = Null
        'Exit Sub
    End If

'----------------------------------------------------------------
'Дале. ...

    iYear = Year(Date)
    iMonth = Month(Date)
    dFirstDY = DateSerial(iYear, 1, 1) 'первое января тек. года
    
    iVal = Nz(Me!cbxSrDatesAuto.Column(0), 0)
    
'Значения (любой период берем с 1 января):
    Select Case iVal
        Case 11     'Текущий месяц
            vStart = DateSerial(iYear, iMonth, 1)
            vEnd = DateSerial(iYear, iMonth + 1, 0) 'Месяц + 1, а Аргумент ДЕНЬ = 0!!!
        
       Case 12  'Позапрошлый месяц
            vStart = DateSerial(iYear, iMonth - 2, 1)
            vEnd = DateSerial(iYear, iMonth - 1, 0) 'Месяц + 1, а Аргумент ДЕНЬ = 0!!!
        
        Case 13     'Прошлый месяц
            vStart = DateSerial(iYear, iMonth - 1, 1)
            vEnd = DateSerial(iYear, iMonth, 0)
            
        Case 21     '1 Квартал тек года
            vStart = dFirstDY 'первое января тек. года
            vEnd = DateAdd("q", 1, vStart) - 1
        
        Case 22     '2 Квартал
            vStart = DateAdd("q", 1, dFirstDY)
            vEnd = DateAdd("q", 2, dFirstDY) - 1
        
        Case 23     '3 Квартал
            vStart = DateAdd("q", 2, dFirstDY)
            vEnd = DateAdd("q", 3, dFirstDY) - 1
        
        Case 24     '4 квартал
            vStart = DateAdd("q", 3, dFirstDY)
            vEnd = DateAdd("q", 4, dFirstDY) - 1
        
        Case 31     '1е Полугодие (тек года)
            vStart = dFirstDY 'первое января тек. года
            vEnd = DateAdd("q", 2, vStart) - 1

        Case 32     '2е Полугодие (тек года)
            vStart = DateAdd("q", 2, dFirstDY)
            vEnd = DateAdd("q", 4, dFirstDY) - 1
        
        Case 41  '9 Месяцев (тек года)
            vStart = dFirstDY 'первое января тек. года
            vEnd = DateAdd("m", 9, vStart) - 1
            
        Case 42  '9 Месяцев (Прошлого года)
            vStart = DateSerial(iYear - 1, 1, 1) 'первое января прошлого года
            vEnd = DateAdd("m", 9, vStart) - 1
            
            
        Case 51     'Текущий год
            vStart = dFirstDY
            vEnd = DateSerial(iYear + 1, 1, 0)
        Case 52     'Прошлый год
            vStart = DateSerial(iYear - 1, 1, 1)
            vEnd = dFirstDY - 1
        Case 99 '12 = Очистить поля дат !!!
            vStart = Null
            vEnd = Null
            Me!cbxSrDatesAuto = Null
    End Select
    
    Me!txtSrDataFrom = vStart
    Me!txtSrDataTo = vEnd
    DoEvents
    
    If IsNull(Me!txtSrDataFrom) = True Then
        AIR_Report_PrepareData Me!txtSrDataFrom, Me!txtSrDataTo, -1 'Режим зачистки
        Me.Requery
        Exit Sub
    End If
'----------------------------------------------------------------
'Пошел перерасчёт ...
    AIR_Report_PrepareData Me!txtSrDataFrom, Me!txtSrDataTo, iVal
    DoEvents
    Me.Requery

End Sub
Eugene-LS вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск