I read in various places that API timers are risky in VBA, that if you edit a cell while the timer is running it will crash Excel.
This code from http://optionexplicitvba.wordpress.com written by Jordan Goldmeier does not seem to have this problem. It fades a pop-up using the timer and while its fading, I can click and enter text in cells and the formula bar.
When is the API timer safe and when is it not? Are there some specific principles to help me understand? And what is the mechanism of the crash: what is happening exactly to make Excel crash?
Option Explicit
Public Declare Function SetTimer Lib "user32" ( _
ByVal HWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
ByVal HWnd As Long, _
ByVal nIDEvent As Long) As Long
Public TimerID As Long
Public TimerSeconds As Single
Public bTimerEnabled As Boolean
Public iCounter As Integer
Public bComplete As Boolean
Public EventType As Integer
Public Sub Reset()
With Sheet1.Shapes("MyLabel")
.Fill.Transparency = 0
.Line.Transparency = 0
.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
End With
Sheet1.Shapes("MyLabel").Visible = msoTrue
End Sub
Sub StartTimer()
iCounter = 1
Reset
TimerID = SetTimer(0&, 0&, 0.05 * 1000&, AddressOf TimerProc)
End Sub
Sub EndTimer()
KillTimer 0&, TimerID
bTimerEnabled = False
bComplete = True
End Sub
Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
ByVal nIDEvent As Long, ByVal dwTimer As Long)
On Error Resume Next
Debug.Print iCounter
If iCounter > 50 Then
With Sheet1.Shapes("MyLabel")
.Fill.Transparency = (iCounter - 50) / 50
.Line.Transparency = (iCounter - 50) / 50
.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = _
RGB((iCounter - 50) / 50 * 224, _
(iCounter - 50) / 50 * 224, _
(iCounter - 50) / 50 * 224)
End With
End If
If iCounter > 100 Then
Sheet1.Shapes("MyLabel").Visible = msoFalse
EndTimer
End If
iCounter = iCounter + 1
End Sub
Public Function ShowPopup(index As Integer)
Sheet1.Range("Hotzone.Index").Value = index
iCounter = 1
If bTimerEnabled = False Then
StartTimer
bTimerEnabled = True
Reset
Else
Reset
End If
With Sheet1.Shapes("MyLabel")
.Left = Sheet1.Range("Hotzones").Cells(index, 1).Left + _
Sheet1.Range("Hotzones").Cells(index, 1).Width
.Top = Sheet1.Range("Hotzones").Cells(index, 1).Top - _
(.Height / 2)
End With
Sheet1.Range("a4:a6").Cells(index, 1).Value = index
End Function
See Question&Answers more detail:os