Timer to flash msg on a form

  • Thread starter Thread starter Les Stout
  • Start date Start date
L

Les Stout

Good day all, i would like to "Flash" a msg on a form and i have used
the following which works, it is just too slow and need it to flash
quicker... Can anybody help please ?

Sub test4()

With UserForm2.Label1
.Caption = "ERROR"
.Font.Name = "Arial"
.Font.Size = 14
.Font.Bold = True
.WordWrap = True
.BackColor = RGB(253, 7, 100)
End With
Application.OnTime Now + TimeValue("00:00:01"), "test5"

End Sub
Sub test5()

With UserForm2.Label1
.Caption = ""
.Font.Name = "Arial"
.Font.Size = 14
.Font.Bold = True
.WordWrap = True
.BackColor = RGB(255, 255, 255)
End With
Application.OnTime Now + TimeValue("00:00:01"), "test4"

End Sub


Best regards,

Les Stout
 
Good day all, i would like to "Flash" a msg on a form and i have used
the following which works, it is just too slow and need it to flash
quicker... Can anybody help please ?

Sub test4()

With UserForm2.Label1
.Caption = "ERROR"
.Font.Name = "Arial"
.Font.Size = 14
.Font.Bold = True
.WordWrap = True
.BackColor = RGB(253, 7, 100)
End With
Application.OnTime Now + TimeValue("00:00:01"), "test5"

End Sub
Sub test5()

With UserForm2.Label1
.Caption = ""
.Font.Name = "Arial"
.Font.Size = 14
.Font.Bold = True
.WordWrap = True
.BackColor = RGB(255, 255, 255)
End With
Application.OnTime Now + TimeValue("00:00:01"), "test4"

End Sub

Best regards,

Les Stout

*** Sent via Developersdexhttp://www.developersdex.com***
Click to expand...

Try using the TimeSerial Function instead of the TimeValue Function.

Matt
 
Les,

Try this.

In my example, the message is started by one button and stopped by another,
you will need to adapt to your situation.

This goes in a standard code module

Option Explicit
Option Private Module

'-----------------------------------------------------------------
' Application Constants
'-----------------------------------------------------------------
Public Const AppId As String = "xldTimer"
Public Const AppTitle As String = "xld Timer Add-In"
Public Const AppHead As String = "xld Timer"
Public Const AppMenu As String = "xld Ti&mer"


Public nTimeEnd As Double

'-----------------------------------------------------------------
' Win32 APIs
'-----------------------------------------------------------------
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 WindowsTimer As Long

'-----------------------------------------------------------------
Public Sub StartTimer()
'-----------------------------------------------------------------
fncWindowsTimer 333, WindowsTimer '1/3 sec
End Sub

'-----------------------------------------------------------------
Public Sub StopTimer()
'-----------------------------------------------------------------
fncStopWindowsTimer
End Sub

'-----------------------------------------------------------------
Public Function cbkRoutine(ByVal Window_hWnd As Long, _
ByVal WindowsMessage As Long, _
ByVal EventID As Long, _
ByVal SystemTime As Long) As Long
'-----------------------------------------------------------------
Dim CurrentTime As String
On Error Resume Next
UpdateForm
End Function

'-----------------------------------------------------------------
Public Function fncStopWindowsTimer()
'-----------------------------------------------------------------
KillTimer hWnd:=FindWindow("XLMAIN", Application.Caption), _
nIDEvent:=0 'WindowsTimer
End Function


'-----------------------------------------------------------------
Public Function fncWindowsTimer(TimeInterval As Long, _
WindowsTimer As Long) As Boolean
'-----------------------------------------------------------------
WindowsTimer = 0
WindowsTimer = SetTimer(hWnd:=FindWindow("XLMAIN", Application.Caption),
_
nIDEvent:=0, _
uElapse:=TimeInterval, _
lpTimerFunc:=AddressOf UpdateForm)

fncWindowsTimer = CBool(WindowsTimer)

DoEvents

End Function

'-----------------------------------------------------------------
Public Function UpdateForm()
'-----------------------------------------------------------------
Static FlipFlop As Boolean

With Userform2.Label1
.Font.Name = "Arial"
.Font.Size = 14
.Font.Bold = True
.WordWrap = True
FlipFlop = Not FlipFlop
If FlipFlop Then
.Caption = "ERROR"
.BackColor = RGB(253, 7, 100)
Else
.Caption = ""
.BackColor = RGB(255, 255, 255)
End If
End With

End Function



and this goes on the form

Option Explicit

Private mStopTime As Double

Private Sub cmdQuit_Click()
StopTimer
Unload Me
End Sub


Private Sub cmdStart_Click()
StartTimer
End Sub

Private Sub cmdStop_Click()
StopTimer
End Sub

Private Sub UserForm_Initialize()
mStopTime = 0
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
StopTimer
End Sub


--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)
 
Just don't send me the workbook, I don't want to fit <bg>

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)
 
I would not have done that without asking Bob and only do that to
explain a problem. I apologize if i have done so before to get your back
up... :0(

Best regards,

Les Stout
 
It was a joke Les Flashing lights have been shown to induce epileptic fits
in some people. I was alluding to your flashing error messages.

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)
 
Oops, thank you for that and sorry for the misunderstanding. Bob, did
you see my other thread about the icons ??

Best regards,

Les Stout
 
Back
Top