<Excel Timer ⁄ >

''' <summary>
''' Using a VBA Timer in Excel
''' </summary>
''' <author>pedrocorreia.net</author>
 
Option Explicit
 
Private Const MySheet As String = "Sheet1"
 
Private Const MyCellClock As String = "A1"
Private Const MyCellFortune As String = "A2"
 
Private Const MyIntervalClock As Integer = 1
Private Const MyIntervalFortune As Integer = 5
 
Private MyQuotes As New Collection
 
''' <summary>
''' This function allow us to write in a cell the computer time, just like a clock
''' </summary>
Public Sub MyTimer()
    'set the cell value with the current time
    SetCurrentTime MySheet, MyCellClock
 
    'Set timer to execute (again) this function
    SetTimerInterval ThisWorkbook.CodeName & ".MyTimer", MyIntervalClock
End Sub
 
''' <summary>
''' This function allow us to write in cell some random "fortune telling" quotes
''' </summary>
Public Sub FortuneTeller()
    If MyQuotes.Count = 0 Then InitQuotes
 
    'set the cell value with a random quote
    SetCellValue MySheet, MyCellFortune, MyQuotes.Item(GetRandomNumber(1, MyQuotes.Count))
 
    'Set timer to execute (again) this function
    SetTimerInterval ThisWorkbook.CodeName & ".FortuneTeller", MyIntervalFortune
End Sub
 
''' <summary>
''' Write the current Time to a Cell
''' </summary>
''' <param name="sheet_name">Sheet Name</param>
''' <param name="cell">Cell Reference</param>
''' <param name="mask">[Optional] Time Format</param>
''' <remarks>Default mask="DD-MMM-YYYY HH:mm:ss"</remarks>
Public Sub SetCurrentTime(sheet_name As String, cell As String, Optional mask As String = "YYYY-MM-DD HH:mm:ss")
     SetCellValue sheet_name, cell, Format(Now, mask)
End Sub
 
''' <summary>
''' Create the Timer, on which a given funcion will be executed at a specified time interval
''' </summary>
''' <param name="callback_function">What function to execute at a specified time interval</param>
''' <param name="seconds_interval">[Optional] Time interval to execute a callback_function</param>
''' <remarks>seconds_interval must be >=1</remarks>
Public Sub SetTimerInterval(callback_function As String, Optional seconds_interval As Integer = 1)
    If Not IsValidInterval(seconds_interval) Then MsgBox "TimeIntervalError", vbCritical: Exit Sub
 
    Dim time_value
 
    'Convert seconds to time format "hh:mm:ss"
    time_value = Format(DateAdd("s", seconds_interval, "00:00:00"), "hh:mm:ss")
 
    'Set time to execute a specific function
    Application.OnTime Now + TimeValue(time_value), callback_function
End Sub
 
''' <summary>
''' Set a Cell value
''' </summary>
''' <param name="sheet_name">Sheet Name</param>
''' <param name="cell">Cell Reference</param>
''' <param name="value">Value</param>
Public Function SetCellValue(sheet As String, cell As String, value As String)
    ActiveWorkbook.Sheets(sheet).Range(cell) = value
End Function
 
''' <summary>
''' Check if we entered a number >0
''' </summary>
''' <param name="value">Number</param>
''' <returns>Boolean</returns>
Private Function IsValidInterval(value As Integer) As Boolean
    IsValidInterval = (value > 0)
End Function
 
''' <summary>
''' Fill collection with dummy values
''' </summary>
Private Sub InitQuotes()
    Set MyQuotes = Nothing
    MyQuotes.Add "one fate"
    MyQuotes.Add "two luck"
    MyQuotes.Add "three fengshui"
    MyQuotes.Add "four karma"
    MyQuotes.Add "five education"
End Sub
 
''' <summary>
''' Generate a random number between an interval
''' </summary>
''' <param name="start_at">From</param>
''' <param name="end_at">Until</param>
''' <returns>Random Number</returns>
Private Function GetRandomNumber(start_at As Integer, end_at As Integer) As Integer
    Randomize
    GetRandomNumber = Int((end_at - start_at + 1) * Rnd + start_at)
End Function
 
''' this event will be triggered as soon as our excel file's open
Private Sub Workbook_Open()
    MyTimer
    FortuneTeller
End Sub