Can a cell be made to flash?

N

newman

Is it possible to have either the text or background in a cell flash or
blink at a regular rate?

Regards
 
M

Miyahn

Is it possible to have either the text or background in a cell flash or
blink at a regular rate?

Copy & paste the following code to ThisWorkbook's code module.
Save the book, close the book, and reopen the book.
If you copy the conditional format of cell 'A1' to another cells, these
cells also blink.

# On Excel2003, you will see an alert when you open the book.

Option Explicit
Private Sub Workbook_Open()
SetTimer
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Me.Sheets(1).DHTMLEdit1.DOM.Script.StopTimer
On Error GoTo 0
End Sub
Private Sub SetTimer()
Dim aObject As Object, Found As Boolean
With Me.Sheets(1)
For Each aObject In .OLEObjects
If aObject.Name = "DHTMLEdit1" Then Found = True
Next aObject
If Not Found Then
On Error Resume Next
.OLEObjects.Add "DHTMLEdit.DHTMLEdit.1"
On Error GoTo 0
With Sheets(1).Cells(1)
.Value = "Blink Text"
.FormatConditions.Add(xlExpression, , "=State=0") _
.Font.ColorIndex = 2
End With
Me.Names.Add "State", "=1"
End If
End With
Application.OnTime Now + TimeValue("00:00:01"), _
"ThisWorkbook.StartTimer"
End Sub
Private Sub StartTimer()
Dim Src(15) As String
Src(0) = "<Script Language = VBS>"
Src(1) = "Dim tId, xlApp, Proc"
Src(2) = "Sub CallBack()"
Src(3) = " On Error Resume Next"
Src(4) = " xlApp.Run Proc"
Src(5) = " On Error GoTo 0"
Src(6) = "End Sub"
Src(7) = "Sub StartTimer(Arg1, Arg2, Arg3)"
Src(8) = " Set xlApp = Arg1: Proc = Arg2"
Src(9) = " tId = window.setInterval(""CallBack"", Arg3) "
Src(10) = "End Sub"
Src(11) = "Sub StopTimer()"
Src(12) = " Set Target = Nothing: window.clearInterval tId"
Src(13) = " tId = 0"
Src(14) = "End Sub"
Src(15) = "</Script>"
With Me.Sheets(1).DHTMLEdit1
.Width = 0: .Height = 0: .BrowseMode = True
.DocumentHTML = Join(Src, vbCrLf)
Do While .Busy: DoEvents: Loop
Me.Sheets(1).Select
.DOM.Script.StartTimer Application, _
"ThisWorkbook.SetState", 500 ' Interval = 500ms
End With
End Sub
Public Sub SetState()
If Me.Names("State") = "=1" Then
Me.Names.Add "State", "=0"
Else
Me.Names.Add "State", "=1"
End If
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top