Knipperende cel met VBA

[AlexCEL]

VBA-specialisten: ik wil een cel (of enkele cellen) continu laten knipperen. Enig speurwerk heeft mij onderstaande code opgeleverd: (bron: https://www.extendoffice.com/documents/excel/3812-excel-blinking-text.html )

Sub StartBlink()
    Dim xCell As Range
    Dim xTime As Variant
    Set xCell = Range("E10")
    With ThisWorkbook.Worksheets("Blad1").Range("A10000").Font
        If xCell.Font.Color = vbRed Then
            xCell.Font.Color = vbWhite
            xCell.Interior.ColorIndex = 1
        Else
            xCell.Font.Color = vbRed
            xCell.Interior.ColorIndex = 6
        End If
    End With
    xTime = Now + TimeSerial(0, 0, 1)
    Application.OnTime xTime, "'" & ThisWorkbook.Name & "'!StartBlink", , True
End Sub

Deze code wordt echter gestart en gestopt met een knop. Ik wil dus iets wat altijd knippert. Op zich lukt mij dat wel met een Worksheet_open event, probleem is echter dat het workbook daarna niet meer te sluiten is (vandaar ook mijn voorbeeldje eerst maar niet bijgevoegd). Dus: hoe stop ik deze code weer bij afsluiten van het workbook?

Misschien is er ook nog wel betere code te bedenken. Ik sta uiteraard open voor suggesties, want VBA is niet mijn sterkste punt.

 

[SjonR]

Deze in een module:

Sub KnipperRood()
Sheets(1).Cells(10, 5).Interior.Color = vbRed
Sheets(1).Cells(10, 5).Font.Color = vbWhite
Application.OnTime Now + TimeValue("00:00:01"), "KnipperGeel"
End Sub

Sub KnipperGeel()
Sheets(1).Cells(10, 5).Interior.Color = vbYellow
Sheets(1).Cells(10, 5).Font.Color = vbRed
Application.OnTime Now + TimeValue("00:00:01"), "KnipperRood"
End Sub

Sub Stoppen()
Application.OnTime Now + TimeValue("00:00:01"), "KnipperRood", schedule:=False
End Sub

en deze spreken voor zich:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Stoppen
End Sub

Private Sub Workbook_Open()
KnipperRood
End Sub

Moet volgens mij genoeg zijn.

 

[AlexCEL]

Hartelijk dank voor de reactie Sjon. Het knipperen gaat prima, maar het afsluiten nog niet. Het werkboek blijft zichzelf steeds opnieuw openen.

Zie bijlage voor foutmelding (let op: ik moest Excel afsluiten via taakbeheer, dus zorg dat je niets anders open hebt staan...)

 

[JeanPaul28]

Sub Stoppen()
exit sub
End Sub

vervang deze eens

 

[AlexCEL]

Het werkboek blijft zich helaas opnieuw openen na afsluiten.

Bijzonder...

 

[E v R]

Zet Now + TimeValue("00:00:01") in 2 publieke variabelen (of Private afhankelijk van lokatie)

Bij het stopzetten van de ontime moet je de de exacte tijd meegeven welke je reeds hebt meegegeven

 

[AlexCEL]

Dank voor de reactie Eric, maar gezien mijn beperkte VBA kennis kan ik dit niet zo 1-2-3 implementeren... bovenstaande is voor mij een beetje abracadabra.

 

[E v R]

Zie bestandje,
eea aangepast, nu nog 1 ontime macro en alles in ThisWorkbook module gezet.

 

[SjonR]

Wil je deze eens testen:

Module:

Public Volgende As Double


Sub Knipper()
If  Sheets(1).Cells(10, 5).Interior.Color = vbRed Then
          Sheets(1).Cells(10, 5).Interior.Color = vbYellow
          Sheets(1).Cells(10, 5).Font.Color = vbRed
Else
          Sheets(1).Cells(10, 5).Interior.Color = vbRed
          Sheets(1).Cells(10, 5).Font.Color = vbWhite
End If

Volgende = Now + TimeValue("00:00:01")
Application.OnTime Volgende, "Knipper"
End Sub


Sub Stoppen()
Application.OnTime Volgende, "Knipper", schedule:=False
End Sub

Workbook_open:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Stoppen
End Sub

Private Sub Workbook_Open()
Knipper
End Sub

 

[AlexCEL]

Dikke :thumb: voor jullie beiden. Het is voor elkaar!

Dank voor de assistentie.