728x90
반응형
Module1: Window API를 활용한 예제
Option Explicit
Option Private Module
#If VBA7 And Win64 Then ' 64 bit Excel under 64-bit windows
' Use LongLong and LongPtr
Private Declare PtrSafe Function SetTimer Lib "user32" _
(ByVal hwnd As LongPtr, _
ByVal nIDEvent As LongPtr, _
ByVal uElapse As LongLong, _
ByVal lpTimerFunc As LongPtr _
) As LongLong
Public Declare PtrSafe Function KillTimer Lib "user32" _
(ByVal hwnd As LongPtr, _
ByVal nIDEvent As LongPtr _
) As LongLong
Public TimerID(2) As LongPtr
#ElseIf VBA7 Then ' 64 bit Excel in all environments
' Use LongPtr only, LongLong is not available
Private Declare PtrSafe Function SetTimer Lib "user32" _
(ByVal hwnd As LongPtr, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" _
(ByVal hwnd As LongPtr, _
ByVal nIDEvent As Long) As Long
Public TimerID(2) As LongPtr
#Else ' 32 bit Excel
Private 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(2) As Long
#End If
Sub Start_Timer()
Stop_Timer
Dim TimerSeconds As Integer
TimerSeconds = 1: isOnTime = False
TimerID(0) = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf program1472_com_1)
TimerID(1) = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf program1472_com_2)
TimerID(2) = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf program1472_com_3)
End Sub
Sub Stop_Timer()
KillTimer 0&, TimerID(0): KillTimer 0&, TimerID(1): KillTimer 0&, TimerID(2)
Application.StatusBar = False
End Sub
Sub program1472_com_1()
program_timer_work Range("A4"), "TextBox 1"
End Sub
Sub program1472_com_2()
program_timer_work Range("A11"), "TextBox 4"
End Sub
Sub program1472_com_3()
program_timer_work Range("A18"), "TextBox 6"
End Sub
Sub program_timer_work(ByRef c As Range, ByVal shpName As String)
c = c - TimeValue("00:00:01")
If c <= 0 Then c = TimeValue("00:00:15"): If isOnTime Then Application.Speech.Speak "Joang Reo"
Dim shp As Shape: Set shp = Sheet1.Shapes(shpName)
shp.Fill.ForeColor.RGB = RGB(IIf(c.Value <= TimeValue("00:00:05"), 255, 0), 0, 0)
End Sub
Module2: OnTime 매소드를 활용한 예제
Dim TimerValue As Date
Public isOnTime As Boolean
Sub sTimer()
TimerValue = Now + TimeValue("00:00:01"): isOnTime = True
Application.OnTime TimerValue, "program1472_com_4"
Application.OnTime TimerValue, "program1472_com_5"
Application.OnTime TimerValue, "program1472_com_6"
End Sub
Sub eTimer()
Application.OnTime TimerValue, "program1472_com_4", , False
Application.OnTime TimerValue, "program1472_com_5", , False
Application.OnTime TimerValue, "program1472_com_6", , False
End Sub
Sub program1472_com_4()
program_timer_work Range("A4"), "TextBox 1"
TimerValue = Now + TimeValue("00:00:01")
Application.OnTime TimerValue, "program1472_com_4"
End Sub
Sub program1472_com_5()
program_timer_work Range("A11"), "TextBox 4"
TimerValue = Now + TimeValue("00:00:01")
Application.OnTime TimerValue, "program1472_com_5"
End Sub
Sub program1472_com_6()
program_timer_work Range("A18"), "TextBox 6"
TimerValue = Now + TimeValue("00:00:01")
Application.OnTime TimerValue, "program1472_com_6"
End Sub
Win API를 이용한 타이머 동작 동영상
OnTime 매소드를 이용한 타이머 동작 동영상
두가지 방법 모두 단점이 존재합니다.
OnTime 매소드를 활용할경우 정확성이 떨어집니다.
반대로 Window API를 이용할경우 정확성은 1/000초 단위로 설정할 수 있으나 오류가 발생할경우 치명적인 결과를 초래합니다.
활용은 필요에 따라서 초이스 하는 능력또한 프로그래머의 능력입니다.
반응형
댓글