Есть ли способ симулировать системную дату?

Question

Итак, у меня есть макрос, который я хочу запускать только в будние дни. Я создал макрос, который (я надеюсь) проверит, какой это день недели, и поместит его в ячейку. Вот что у меня есть:

Private Sub dayCheck()

    If Weekday(Now) = vbMonday Or vbTuesday Or vbWednesday Or vbThursday Or vbFriday Then
        Dim BlankRow As Long
        BlankRow = Range("A65536").End(xlUp).Row + 1
        Cells(BlankRow, 1).Select
        Selection.Value = Date
        Selection.Offset(0, 1).Value = Time
        Selection.Offset(0, 2).Value = WeekdayName(Weekday(Now))
        Selection.Offset(0, 3).Value = Environ("Username")

    ElseIf Weekday(Now) = vbSaturday Or vbSunday Then
        Dim time1, time2

        Do
            time1 = Weekday(Now)
            time2 = vbMonday
            Do Until time1 = time2
                DoEvents
                time1 = Now()
            Loop
        Loop

    End If

    Application.OnTime TimeValue("12:00:00"), "dayCheck"

End Sub

Моя проблема в том, что у меня нет прав администратора для изменения системной даты. Есть ли способ, которым я могу симулировать это с помощью макроса?

Answer 1

Вы можете смоделировать код даты, отформатировав общий или числовой вывод функции now () в excel, и просто добавьте 1, чтобы увеличить дату. Числа справа от десятичной запятой представляют процент времени после полуночи до следующего дня.

Сегодняшний код даты и времени: 43412.37786

Завтра 43413.37786

Таким образом, на ваш вопрос о тестировании вашего кода можно ответить, создав цикл for:

Dim Today
Today = Now
For Days = Today To Today + 7 'Tests today through next Thursday.
    If Weekday(Days) = ...
Next Days

Но ответ Даррена выглядит так, как будто он решает вашу проблему, так что я бы, наверное, просто согласился с этим.

Answer 2

• Now дает дату / время, Date дает только дату.

• Weekday(Date) возвращает номер текущего дня недели с воскресеньем 1.

• Так как сегодня четверг, Weekday(Now)=vbMonday вернет False.

• Weekday(Now) = vbMonday Or vbTuesday Or vbWednesday Or vbThursday Or vbFriday возвращает 7 - я не знаю почему, но это так. Главное здесь, это не возвращает TRUE или FALSE.
  • Чтобы это утверждение работало, вам нужно использовать
    Weekday(Now) = vbMonday Or Weekday(Now) = vbTuesday Or Weekday(Now) = vbWednesday Or Weekday(Now) = vbThursday Or Weekday(Now) = vbFriday.
    Более простой способ - Weekday(Date,vbMonday)<=5 - vbMonday нумерация недели понедельник = 1, воскресенье = 7 и ответ на вопрос «Является ли дата днем ​​недели?».

Вот код:

    Sub Test()

       'DayCheck Now
       'Or
       'DayCheck #11/7/2018 6:55:00 PM#

        'Or look at next 7 days starting now.
        Dim x As Long
        Dim StartDate As Date

        StartDate = Now

        For x = 0 To 6
            DayCheck StartDate + x
        Next x

    End Sub

    Sub DayCheck(MyDate As Date)

        Dim rLastCell As Range
        Dim wrkSht As Worksheet

        Set wrkSht = ThisWorkbook.Worksheets("Sheet1")

        If Weekday(MyDate, vbMonday) <= 5 Then
            Set rLastCell = wrkSht.Cells(Rows.Count, 1).End(xlUp).Offset(1) 'Reference to the blank cell itself.
            rLastCell.Resize(, 4) = Array(MyDate, MyDate, MyDate, Environ("Username"))

            rLastCell.NumberFormat = "dd-mmm-yy"
            rLastCell.Offset(, 1).NumberFormat = "hh:mm AM/PM"
            rLastCell.Offset(, 2).NumberFormat = "dddd"

        Else 'No need to check if it's a weekend - we know it's not a weekday.

           'Just keep running until time1 = 2 and time2 = 2?
           'I guess that'll be Midnight on Monday?

        End If

    End Sub

Заметьте, я помещаю одно и то же значение в столбцы A:C - только дату и время.
Затем я форматирую каждую ячейку, чтобы показать интересующую вас часть даты и времени.