Excelでタイマー処理

　ExcelでWindows APIを使うのはあまり好きではないのですが、Windows APIを使うからこそできることもあります。
　てなわけで、暇つぶしにWindos APIのタイマーを使ってみたサンプルです。
　waitTime関数はただ時間を待つだけです。loopTest関数はひたすら無限ループします。

　まぁ、次回以降のおもちゃを作るための準備なんですが。。。

　例によって、動作保証はしませんが、ソースコードはご自由にお使いください。



Option Explicit

'--------------------------------------------------
'                   APIの宣言
'--------------------------------------------------
'DWORD timeGetTime( VOID);
Public Declare PtrSafe Function timeGetTime Lib "WINMM.DLL" () As Long

'SHORT GetAsyncKeyState( int vKey);
Public Declare PtrSafe Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Long
Public Const VK_ENTER As Integer = 13
Public Const VK_ESC As Integer = 27
Public Const VK_SPACE As Integer = 32
Public Const VK_LEFT As Integer = 37
Public Const VK_UP As Integer = 38
Public Const VK_RIGHT As Integer = 39
Public Const VK_DOWN As Integer = 40

'VOID Sleep( DWORD dwMilliseconds);
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'BOOL sndPlaySound( LPCSTR lpszSound, UINT fuSound);
Public Declare PtrSafe Function sndPlaySound Lib "WINMM.DLL" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Public Const SND_SYNC = &H0
Public Const SND_ASYNC = &H1
Public Const SND_NODEFAULT = &H2
Public Const SND_LOOP = &H8
Public Const SND_NOSTOP = &H10
'--------------------------------------------------

Public Sub timerTest()
    waitTime (3000)
    MsgBox "waited 3 sec"
End Sub

Public Sub clear()
    Sheet1.Cells.Delete
End Sub

Public Function waitTime(timeToWait As Integer)
    Dim timeNext As Long
    timeNext = timeGetTime() + timeToWait
 
    '----- ループ -----
    Do While timeGetTime() < timeNext
        'Sheet1.Cells(1, 1).Select
        DoEvents
    Loop
    '------------------
End Function

Public Function playSound(SoundName As String)
    Dim wFlags As Long
 
    wFlags = SND_ASYNC Or SND_NODEFAULT
    playSound = sndPlaySound(SoundName, wFlags)
End Function

Public Sub loopTest()
    Dim timeNext As Long
    Dim loopFlag As Boolean
 
    timeNext = timeGetTime
    loopFlag = True
 
    '----- メインループ -----
    Do While loopFlag = True
        If timeNext < timeGetTime Then
     
            '----- ESC Keyで終了 -----
            If GetAsyncKeyState(VK_ESC) <> 0 Then
                loopFlag = False
            End If
     
            '-------------------------
            timeNext = timeNext + 100
        End If
 
        '-------------------------
        Sheet1.Cells(1, 1).Select
        DoEvents
    Loop
    '------------------------
End Sub