ExcelのVBAでタイマを使う
ボールが16x12の中をバウンドするプログラム。
initを実行した後 timerStartStopを実行すると動いたり止まったりする。
久しぶりにタイマ使って楽しかった。
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 Sub init() Set w = ThisWorkbook.Worksheets(2) w.Cells(1, 1).Value = 1 'x w.Cells(2, 1).Value = 1 'y w.Cells(3, 1).Value = 1 'xx w.Cells(4, 1).Value = 1 'yy w.Cells(5, 1).Value = 16 'x limit w.Cells(6, 1).Value = 12 'y limit w.Cells(1, 2).Value = "" 'Timer ID End Sub Sub move() On Error Resume Next Set w = ThisWorkbook.Worksheets(2) Set x = w.Cells(1, 1) Set y = w.Cells(2, 1) Set xx = w.Cells(3, 1) Set yy = w.Cells(4, 1) ThisWorkbook.Worksheets(1).Cells(y.Value, x.Value).Value = "" x.Value = x.Value + xx.Value y.Value = y.Value + yy.Value ThisWorkbook.Worksheets(1).Cells(y.Value, x.Value).Value = "●" If x.Value >= w.Cells(5, 1).Value Then xx.Value = -1 If x.Value <= 1 Then xx.Value = 1 If y.Value >= w.Cells(6, 1).Value Then yy.Value = -1 If y.Value <= 1 Then yy.Value = 1 End Sub Sub TimerStartStop() Set c = ThisWorkbook.Worksheets(2).Cells(1, 2) If c.Value = "" Then ThisWorkbook.Worksheets(2).Cells(1, 2).Value = SetTimer(0&, 31000&, 50&, AddressOf move) Else KillTimer 0&, c.Value c.Value = "" End If End Sub