做while循环不允许用户控制

Question

如果该单元格值包含今天的日期，则此子单元格将闪烁。

从VBA编辑器运行时，我可以打开其他用户窗体或照常使用项目。

当另一个子程序调用TransNotification子程序时，我无法使程序屈服于用户。子必须从VBA编辑器中停止。我已将DoEvents放置在Do While循环的多个部分中，但没有成功。

Public flash As Boolean
Sub TransNotification()
    Dim dateexists As Integer
    Dim rightnow As String

    rightnow = Format(Now(), "mm/dd/yy")
    dateexists = InStr(1, Sheet2.Range("R64").Value, rightnow)
    If dateexists <> 0 Then
        flash = True
    End If
    Sheet2.Unprotect
    Do While flash

        Sheet2.Range("R64").Interior.Color = RGB(39, 70, 32)
        WasteTime (1500)
        Sheet2.Range("R64").Interior.Color = RGB(50, 50, 50)
        WasteTime (1000)

        rightnow = Format(Now(), "mm/dd/yy")
        dateexists = InStr(1, Sheet2.Range("R64").Value, rightnow)
        If dateexists = 0 Then
            flash = False
        End If

    Loop
    Sheet2.Unprotect
    Sheet2.Range("R64").Interior.Color = RGB(50, 50, 50)
    Sheet2.Protect
End Sub

Sub WasteTime(Finish As Long)
    Dim NowTick As Long
    Dim EndTick As Long

    EndTick = GetTickCount + Finish

    Do
        NowTick = GetTickCount
        DoEvents
    Loop Until NowTick >= EndTick
End Sub