Как AutoUpdate, поскольку каждый день проходит условный формат, основанный на дате?

Question

Я новичок в написании кода VBA, но мне удавалось бороться за последние пару недель.

Я создал код для события изменения рабочего листа, который выдвигает на первый план ввода в определенные сроки в отдельных окнах, как так:

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim icolor As Integer 
    Dim cell As Range 
    If Intersect(Target, Range("C3:T65")) Is Nothing Then Exit Sub 
    For Each cell In Target 
     icolor = 0 
     Select Case cell 
     Case "": icolor = 2 
     Case Is <= Date + 30: icolor = 3 
     Case Is <= Date + 60: icolor = 6 
     Case Is > Date + 60: icolor = 2 
     End Select 
     If icolor <> 0 Then cell.Interior.ColorIndex = icolor 
    Next cell 
End Sub 

Он работает безупречно. Тем не менее, мне нужна электронная таблица, чтобы в основном обновлять подсветку каждый день. IE: Если дата + 61 не подсвечена сегодня, она будет подсвечена завтра, потому что она подходит для окна как Дата + 60. Я подозреваю, что простое событие изменения рабочего листа не может этого сделать (потому что для этого требуется ввод пользователя).

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

Спасибо заранее.

Private Sub Worksheet_Activate() 
    Dim icolor As Integer 
    Dim cell As Range 

    If Intersect(Target, Range("C3:T65")) Is Nothing Then Exit Sub 
    For Each cell In Target 
     icolor = 0 
     Select Case cell 
      Case "": icolor = 2  
      Case Is <= Date + 30: icolor = 3 
      Case Is <= Date + 60: icolor = 6 
      Case Is > Date + 60: icolor = 2    
     End Select 
     If icolor <> 0 Then cell.Interior.ColorIndex = icolor 
    Next cell 
End Sub 

Answer 1

Там нет Target параметра, передаваемого Worksheet_activate, так что вы не можете использовать тест Intersect(). Вам просто нужно перебрать вашего диапазона непосредственно

For Each cell In Me.Range("C3:T65").Cells 
    'check value 
Next cell 

Лучший подход здесь должен был бы разделить логику hiliting в отдельную Sub и просто позвонить, что из обработчиков событий:

EDIT: добавлено Workbook_Open

'in ThisWorkbook module 
Private Sub Workbook_Open() 
    Sheet1.CheckData Sheet1.Range("C3:T65") 
End Sub 

'in sheet code module 
Private Sub Worksheet_Activate() 
    CheckData Me.Range("C3:T65") 
End Sub 

Private Sub Worksheet_Change(ByVal Target As Range) 
    CheckData Intersect(Target, Me.Range("C3:T65")) 
End Sub 

Sub CheckData(rng As Range) 
    Dim icolor As Integer 
    Dim cell As Range 

    If rng Is Nothing Then Exit Sub 

    For Each cell In rng.Cells 
     icolor = 0 
     Select Case cell 
      Case "": icolor = 2 
      Case Is <= Date + 30: icolor = 3 
      Case Is <= Date + 60: icolor = 6 
      Case Is > Date + 60: icolor = 2 
     End Select 
     If icolor <> 0 Then cell.Interior.ColorIndex = icolor 
    Next cell 
End Sub