Flash SubProgram
Posted by Wes on January 19, 2001 11:59 AM
I currently have a macro that calculates a number, assigns a corresponding letter grade to this number, and places the letter in the adjacent cell. What I need is a subprogram that I can place at the end of the existing macro that will read those letters that are D's and F's and make them flash (i.e. change the background color from automatic to red to automatic to red and so forth) for as long as the document is open.
Posted by Celia on January 19, 2001 3:24 PM
Assuming the range that may contain D or F is A1:A20, add the following line at the end of your macro :-
Call StartFlash
and add the following procedures to your workbook :-
Dim RunWhen As Double
Dim toFlash As Range
Sub StartFlash()
Dim cell As Range, grades As Range
Dim x%, grade1$, grade2$
Set grades = Range("A1:A20")
grade1 = "D"
grade2 = "F"
On Error Resume Next
Application.OnTime RunWhen, "FlashText", , False
grades.Interior.ColorIndex = xlNone
For Each cell In grades
If cell.Value = grade1 Or cell.Value = grade2 Then
If x = 1 Then
Set toFlash = Union(toFlash, cell)
Else:
Set toFlash = cell
x = 1
End If
End If
Next
If x = 0 Then
MsgBox "There are no " & grade1 & _
" & " & grade2 & " grades."
Exit Sub
End If
RunWhen = Now + TimeSerial(0, 0, 1)
Application.OnTime RunWhen, "FlashText"
End Sub
Sub FlashText()
With toFlash.Interior
If .ColorIndex = xlNone Then
.ColorIndex = 3
Else: .ColorIndex = xlNone
End If
End With
RunWhen = Now + TimeSerial(0, 0, 1)
Application.OnTime RunWhen, "FlashText"
End Sub
Sub StopFlash()
On Error Resume Next
Application.OnTime RunWhen, "FlashText", , False
toFlash.Interior.ColorIndex = xlNone
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call StopFlash
End Sub
Celia
Posted by Wes on January 22, 2001 12:15 PM
Celia; I now need the font to blink instead of the background. I'm having problems with this, can you help??? Would it be of any help if I was to send this document to you? Thank you so much
Posted by Celia on January 22, 2001 4:49 PM
Wes
I think the following does it :-
Dim RunWhen As Double
Dim toFlash As Range
Sub StartFlash()
Dim cell As Range, grades As Range
Dim x%, theGrade$
Set grades = Range("A1:A20")
theGrade = "F"
On Error Resume Next
Application.OnTime RunWhen, "FlashText", , False
grades.Font.ColorIndex = xlAutomatic
For Each cell In grades
If cell.Value = theGrade Then
If x = 1 Then
Set toFlash = Union(toFlash, cell)
Else:
Set toFlash = cell
x = 1
End If
End If
Next
If x = 0 Then
MsgBox "There are no " & theGrade & " grades."
Exit Sub
End If
RunWhen = Now + TimeSerial(0, 0, 1)
Application.OnTime RunWhen, "FlashText"
End Sub
Sub FlashText()
With toFlash.Font
If .ColorIndex = xlAutomatic Then
.ColorIndex = 3
Else: .ColorIndex = xlAutomatic
End If
End With
RunWhen = Now + TimeSerial(0, 0, 1)
Application.OnTime RunWhen, "FlashText"
End Sub
Sub StopFlash()
On Error Resume Next
Application.OnTime RunWhen, "FlashText", , False
toFlash.Font.ColorIndex = xlAutomatic
End Sub
Celia
