Timer to flash msg on a form

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

*** Sent via Developersdex http://www.developersdex.com ***
 
M

meh2030

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***

Try using the TimeSerial Function instead of the TimeValue Function.

Matt
 
B

Bob Phillips

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)
 
B

Bob Phillips

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)
 
L

Les Stout

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

*** Sent via Developersdex http://www.developersdex.com ***
 
B

Bob Phillips

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)
 

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