Flash text

This is a great question! I wondered the same thing just this week. May I tailgate?

How do I get the "bold on and off" to occur only when a specified condition is met. In other words, can I enable it with Conditional Formatting so that when Total Expenses, for example, goes over budget it blinks?

i suppose you might be able use conditional formula in your way, using some kind of macro.

Alternatively, you could use Data Validation, or use Conditinal Formatting to make it red, if your objective like mine is to draw attention to it.

Did you see this

http://www.mrexcel.com/board2/viewtopic.php?t=126456&highlight=text+effects

Regards

To get a cell to flash if a certain number is entered is below,Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value = 50 Then
For n = 1 To 100
Target.Interior.Color = vbRed
Delay (0.04)
Target.Interior.ColorIndex = xlNone
Delay (0.04)
Next n
End If
End Sub

Sub Delay(rTime As Single)
'delay rTime seconds (min=.03, max=10)
Dim oldTime As Variant
'safety net
If rTime < 0.03 Or rTime > 10 Then rTime = 1
oldTime = Timer
Do
DoEvents
Loop Until Timer - oldTime > rTime
End Sub


Not sure how to do it for your case i..e if it goes above a certain value but you may be able to slice and dice the above.

ok then, how do you get a cell, say d8 to flash red, like you've said above by clicking on a button?

ps delay (0.04) does not work because it requires a object to work on e.g. textbox1.delay (0.04). What would this be working on, the targe?

Have a look at Tushar Mehta's solution using Conditional Formatting

http://www.tmehta.com/tmxl/dbfind_byid.asp?id=14

an additional thread if you don't like Tushar's method

http://www.mrexcel.com/board2/viewtopic.php?t=86943&highlight=blinking

Regards

i have studied those, but they don't seem to fit my problem, either that or i am being dense...

Would something like this help? It causes the text to switch between Bold and normal. You could run this from a button or from a Change Event (and adapt it to suit).

Sub BlinkText()
Dim i As Integer

TimeNow = Time
For i = 1 To 8
TimeNext = DateAdd("s", 1, TimeNow)
TimeNow = TimeNext
Application.Wait TimeNext
If Selection.Font.Bold = True Then
Selection.Font.Bold = False
Else
Selection.Font.Bold = True
End If
Next i

End Sub

Regards

GAZZAT5 said:

ok then, how do you get a cell, say d8 to flash red, like you've said above by clicking on a button?

Click to expand...

Purists beware.

This lenghty code is one way to answer the literal meaning of your question. Mostly from Hans Herber, a little from me. Increase the range(s) by adding
FlashingRangeCol
line(s) in the first module.

Important, please follow these directions to test this, which flashes a cell's interior color index from red to white like you asked.

Draw 2 forms buttons on the sheet. After inserting the following code as directed, assign the macro StartCellFlasher to one button, and StopCellFlasher to the other button.

Insert 2 new standard modules for this. In one standard module paste this in:

Option Explicit

Sub StartCellFlasher()
Dim FlashingRangeCol As New Collection
FlashingRangeCol.Add Range("D8")
Call fncStartCellFlashing(FlashingRangeCol, 400)
End Sub

Sub StopCellFlasher()
Call fncStopCellFlashing
End Sub



In the other standard module paste in this monster:


Option Explicit

Private Declare Function FindWindow _
Lib "user32" _
Alias "FindWindowA" _
( _
ByVal lpClassName As String, _
ByVal lpWindowName As String _
) _
As Long

Private Declare Function SetTimer _
Lib "user32" _
( _
ByVal hWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long _
) _
As Long

Private Declare Function KillTimer _
Lib "user32" _
( _
ByVal hWnd As Long, _
ByVal nIDEvent As Long _
) _
As Long

Private Declare Function GetCurrentVbaProject _
Lib "vba332.dll" _
Alias "EbGetExecutingProj" _
( _
hProject As Long _
) _
As Long

Private Declare Function GetFuncID _
Lib "vba332.dll" _
Alias "TipGetFunctionId" _
( _
ByVal hProject As Long, _
ByVal strFunctionName As String, _
ByRef strFunctionID As String _
) _
As Long

Private Declare Function GetAddr _
Lib "vba332.dll" _
Alias "TipGetLpfnOfFunctionId" _
( _
ByVal hProject As Long, _
ByVal strFunctionID As String, _
ByRef lpfn As Long _
) _
As Long

Private WindowsTimer As Long

Private FlashingRangeCollection As Collection

Public Function fncStartCellFlashing _
( _
FlashingRangeCol As Collection, _
FlashingPeriod As Integer _
)
fncStopWindowsTimer
Set FlashingRangeCollection = New Collection
Set FlashingRangeCollection = FlashingRangeCol
fncWindowsTimer CLng(FlashingPeriod)
End Function

Public Function fncStopCellFlashing()
Dim aCell As Variant
On Error Resume Next
fncStopWindowsTimer
For Each aCell In FlashingRangeCollection
aCell.Font.Color = 2
Next aCell
Set FlashingRangeCollection = Nothing
End Function

Private Function fncWindowsTimer( _
TimeInterval As Long _
) As Boolean
Dim WindowsTimer As Long
WindowsTimer = 0
If Val(Application.Version) > 8 Then
WindowsTimer = SetTimer _
( _
hWnd:=FindWindow("XLMAIN", Application.Caption), _
nIDEvent:=0, _
uElapse:=TimeInterval, _
lpTimerFunc:=AddrOf_cbkCustomTimer _
)
Else
WindowsTimer = SetTimer _
( _
hWnd:=FindWindow("XLMAIN", Application.Caption), _
nIDEvent:=0, _
uElapse:=TimeInterval, _
lpTimerFunc:=AddrOf("cbkCustomTimer") _
)
End If
fncWindowsTimer = CBool(WindowsTimer)
End Function

Private Function fncStopWindowsTimer()
KillTimer _
hWnd:=FindWindow("XLMAIN", Application.Caption), _
nIDEvent:=WindowsTimer
End Function

Private Function cbkCustomTimer _
( _
ByVal Window_hWnd As Long, _
ByVal WindowsMessage As Long, _
ByVal EventID As Long, _
ByVal SystemTime As Long _
) _
As Long
Dim aCell As Variant
Static aFlag As Boolean

On Error Resume Next
If aFlag = True Then
For Each aCell In FlashingRangeCollection
aCell.Interior.ColorIndex = 3
Next aCell
aFlag = False
Else
For Each aCell In FlashingRangeCollection
aCell.Interior.ColorIndex = 0
Next aCell
aFlag = True
End If
End Function


Private Function AddrOf _
( _
CallbackFunctionName As String _
) _
As Long
'
Dim aResult As Long, CurrentVBProject As Long, strFunctionID As String, _
AddressOfFunction As Long, UniCbkFunctionName As String
'
'convert the name of the function to Unicode system
UniCbkFunctionName = StrConv(CallbackFunctionName, vbUnicode)
'
'if the current VBProjects exists ...
If Not GetCurrentVbaProject(CurrentVBProject) = 0 Then
'... get the function ID of the callback function based on its name, _
in order to ensure that the function exists
aResult = GetFuncID _
( _
hProject:=CurrentVBProject, _
strFunctionName:=UniCbkFunctionName, _
strFunctionID:=strFunctionID _
)
'if the function exists ...
If aResult = 0 Then
'...get a pointer to the callback function based on strFunctionID
aResult = GetAddr _
( _
CurrentVBProject, _
strFunctionID, _
lpfn:=AddressOfFunction _
)
'if we have got the pointer pass it to the result of the function
If aResult = 0 Then
AddrOf = AddressOfFunction
End If
End If
End If
End Function

Function AddrOf_cbkCustomTimer() As Long
AddrOf_cbkCustomTimer = vbaPass(AddressOf cbkCustomTimer)
End Function
Function vbaPass(AddressOfFunction As Long) As Long
vbaPass = AddressOfFunction
End Function