Функция VBA UDF заставляет excel «не отвечать»

Question

У меня есть очень простой код, вызывающий сбои Excel.

Я отлаживал переменные, как видно из кода, и они выглядят отлично, за исключением того, что через несколько секунд Now() не изменяется и waitTime не изменяется - хотя времена отличаются друг от друга, то есть время (например, теперь может застрять в 3:00:05 и waitTime застрял в 3:00:09).

И application.wait не ждет 5 секунд, которые я просил.

И цвет шрифта ячейки также не изменяется.

Я не знаю, как отлаживать дальше.

На листе «sheet1» у меня есть следующие ячейки: в C8 У меня есть номер, который я изменяю вручную. В D8 у меня есть

=if(C8>25,"yup",startFlash(C8)) 

И это отлично работает. Он вызывает функцию без проблем. Вот код макроса:

Dim waitTime As Date, stopTime As Date 


Function startFlash(x As String) 
    Beep 
    stopTime = TimeSerial(Hour(Now()), Minute(Now()) + 2, Second(Now())) 
    Call sflash 
    MsgBox "done" 
End Function 

Sub sflash() 

    Do While waitTime <= stopTime 

     With Sheet1.Range("c8").Font 
      If .ColorIndex = 3 Then 
       .ColorIndex = 5 
      Else 
      .ColorIndex = 3 
      End If 
     End With 

     newHour = Hour(Now()) 
     newMinute = Minute(Now()) 
     newSecond = Second(Now()) + 5 
     waitTime = TimeSerial(newHour, newMinute, newSecond) 

     Debug.Print Now(); waitTime; stopTime 

     Application.Wait waitTime 
    Loop 

End Sub 

Любые предложения по изменению кода, чтобы остановить Excel от сбоев?

Answer 1

Не полагайтесь только на время, если есть вероятность, что вы пройдете полночь; укажите дату в начале и остановите время.

Option Explicit 

Dim waitTime As Date, stopTime As Date 

Function startFlash(x As String) 
    Beep 
    stopTime = Now + TimeSerial(0, 2, 0) 
    'Debug.Print stopTime 
    Call sflash 
    MsgBox "done" 
End Function 

Sub sflash() 

    Do While waitTime <= stopTime 

     With Sheet1.Range("c8").Font 
      If .ColorIndex = 3 Then 
       .ColorIndex = 5 
      Else 
      .ColorIndex = 3 
      End If 
     End With 

     waitTime = Now + TimeSerial(0, 0, 5) 
     'Debug.Print Now; waitTime; stopTime 

     Do While Now < waitTime: DoEvents: Loop 
    Loop 

End Sub 

Проникновение через DoEvents Function до тех пор, пока ваше время встречи не станет лучшим методом.