<pedrocorreia.net ⁄>
corner
<mySearch ⁄> <mySearch ⁄>

corner
 
corner
<mySnippets order="rand" ⁄> <mySnippets order="rand" ⁄>

corner
 
corner
<myContacts ⁄> <myContacts ⁄>

<email ⁄>


pc@pedrocorreia.net

<windows live messenger ⁄>


pedrojacorreia@hotmail.com

<myCurriculum type="pdf" ⁄>


Download
corner
 
corner
<myBlog show="last" ⁄> <myBlog show="last" ⁄>

corner
 
corner
<myNews show="rand" ⁄> <myNews show="rand" ⁄>

corner
 
corner
<myNews type="cat" ⁄> <myNews type="cat" ⁄>

corner
 
corner
<myQuote order="random" ⁄> <myQuote order="random" ⁄>

corner
 
corner
<myPhoto order="random" ⁄> <myPhoto order="random" ⁄>

<pedrocorreia.net ⁄>
corner
 
corner
<myAdSense ⁄> <myAdSense ⁄>

corner
 
corner
<myVisitorsMap ⁄> <myVisitorsMap ⁄>

corner
 
 

<Excel Timer ⁄ >




clicks: 16504 16504 2008-07-19 2008-07-19 goto mySnippets mySnippets vba  Download  Bookmark This Bookmark This



Here's something that I don't use a lot but maybe could help someone, an Excel Timer.

In VB6 we have a specific control to this, Timer, however in VBA such control doesn't exist.

We can have two approaches to this issue, using Windows Timer, in which you use Windows API by making dll calls; and the other (easier ^_^'') one, Application.OnTime.



MSDN has the following definition: "... Schedules a procedure to be run at a specified time in the future (either at a specific time of day or after a specific amount of time has passed) ...".
We can see this as in Windows Schedule Tasks, we assign a task to run at given Day:Hour or at every interval. You can get more detailed information at msdn.

By looking at Application.OnTime signature it's very straightforward to use it, we have two mandatory and two optional arguments.
Let's focus on mandatory arguments.
We have to specify at what hour we want to execute a schedule and what will we execute (this is our function name). Well, fairly simple, but if you try this you'll notice that that function will only be called one time, yes, that's right, only the first time. Here's the little catch/ trick.

Application.OnTime it's not really the same as a Timer, with a timer you set an interval and "can forget it", because at the specific timer interval something will happen.

The trick to emulate a real timer (this is, every X seconds/ minutes/ hours the program will take some action) is to call the Application.OnTime each time our function is evaluated, this is, the function will call itself. We can easily achieve this by just adding a Application.OnTime at the end function (I don't know if you noticed, but I'm always talking about functions, but of course you can also use Application.OnTime with procedures, you'll see this ahead).


In this simple example we'll have two timers, each one will make something different. In one timer we'll just exhibit our computer Date/ Time, each and every second the cell "A1" will update itself; the other time will fill cell "A2" with some quotes, I called it fortune teller :), at every 5 seconds. While Application.OnTime's working you can make whatever you want in your Worksheet.


By pressing ALT+F11 in your Excel file you'll be taken to VBA window, the following code should be added to your WorkBook, you can also add this do the sheet and not make this global, but keep in mind that some changes are needed.

Here's the code:
  1. ''' <summary>
  2. ''' Using a VBA Timer in Excel
  3. ''' </summary>
  4. ''' <author>pedrocorreia.net</author>
  5.  
  6. Option Explicit
  7.  
  8. Private Const MySheet As String = "Sheet1"
  9.  
  10. Private Const MyCellClock As String = "A1"
  11. Private Const MyCellFortune As String = "A2"
  12.  
  13. Private Const MyIntervalClock As Integer = 1
  14. Private Const MyIntervalFortune As Integer = 5
  15.  
  16. Private MyQuotes As New Collection
  17.  
  18. ''' <summary>
  19. ''' This function allow us to write in a cell the computer time, just like a clock
  20. ''' </summary>
  21. Public Sub MyTimer()
  22. 'set the cell value with the current time
  23. SetCurrentTime MySheet, MyCellClock
  24.  
  25. 'Set timer to execute (again) this function
  26. SetTimerInterval ThisWorkbook.CodeName & ".MyTimer", MyIntervalClock
  27. End Sub
  28.  
  29. ''' <summary>
  30. ''' This function allow us to write in cell some random "fortune telling" quotes
  31. ''' </summary>
  32. Public Sub FortuneTeller()
  33. If MyQuotes.Count = 0 Then InitQuotes
  34.  
  35. 'set the cell value with a random quote
  36. SetCellValue MySheet, MyCellFortune, MyQuotes.Item(GetRandomNumber(1, MyQuotes.Count))
  37.  
  38. 'Set timer to execute (again) this function
  39. SetTimerInterval ThisWorkbook.CodeName & ".FortuneTeller", MyIntervalFortune
  40. End Sub
  41.  
  42. ''' <summary>
  43. ''' Write the current Time to a Cell
  44. ''' </summary>
  45. ''' <param name="sheet_name">Sheet Name</param>
  46. ''' <param name="cell">Cell Reference</param>
  47. ''' <param name="mask">[Optional] Time Format</param>
  48. ''' <remarks>Default mask="DD-MMM-YYYY HH:mm:ss"</remarks>
  49. Public Sub SetCurrentTime(sheet_name As String, cell As String, Optional mask As String = "YYYY-MM-DD HH:mm:ss")
  50. SetCellValue sheet_name, cell, Format(Now, mask)
  51. End Sub
  52.  
  53. ''' <summary>
  54. ''' Create the Timer, on which a given funcion will be executed at a specified time interval
  55. ''' </summary>
  56. ''' <param name="callback_function">What function to execute at a specified time interval</param>
  57. ''' <param name="seconds_interval">[Optional] Time interval to execute a callback_function</param>
  58. ''' <remarks>seconds_interval must be >=1</remarks>
  59. Public Sub SetTimerInterval(callback_function As String, Optional seconds_interval As Integer = 1)
  60. If Not IsValidInterval(seconds_interval) Then MsgBox "TimeIntervalError", vbCritical: Exit Sub
  61.  
  62. Dim time_value
  63.  
  64. 'Convert seconds to time format "hh:mm:ss"
  65. time_value = Format(DateAdd("s", seconds_interval, "00:00:00"), "hh:mm:ss")
  66.  
  67. 'Set time to execute a specific function
  68. Application.OnTime Now + TimeValue(time_value), callback_function
  69. End Sub
  70.  
  71. ''' <summary>
  72. ''' Set a Cell value
  73. ''' </summary>
  74. ''' <param name="sheet_name">Sheet Name</param>
  75. ''' <param name="cell">Cell Reference</param>
  76. ''' <param name="value">Value</param>
  77. Public Function SetCellValue(sheet As String, cell As String, value As String)
  78. ActiveWorkbook.Sheets(sheet).Range(cell) = value
  79. End Function
  80.  
  81. ''' <summary>
  82. ''' Check if we entered a number >0
  83. ''' </summary>
  84. ''' <param name="value">Number</param>
  85. ''' <returns>Boolean</returns>
  86. Private Function IsValidInterval(value As Integer) As Boolean
  87. IsValidInterval = (value > 0)
  88. End Function
  89.  
  90. ''' <summary>
  91. ''' Fill collection with dummy values
  92. ''' </summary>
  93. Private Sub InitQuotes()
  94. Set MyQuotes = Nothing
  95. MyQuotes.Add "one fate"
  96. MyQuotes.Add "two luck"
  97. MyQuotes.Add "three fengshui"
  98. MyQuotes.Add "four karma"
  99. MyQuotes.Add "five education"
  100. End Sub
  101.  
  102. ''' <summary>
  103. ''' Generate a random number between an interval
  104. ''' </summary>
  105. ''' <param name="start_at">From</param>
  106. ''' <param name="end_at">Until</param>
  107. ''' <returns>Random Number</returns>
  108. Private Function GetRandomNumber(start_at As Integer, end_at As Integer) As Integer
  109. Randomize
  110. GetRandomNumber = Int((end_at - start_at + 1) * Rnd + start_at)
  111. End Function
  112.  
  113. ''' this event will be triggered as soon as our excel file's open
  114. Private Sub Workbook_Open()
  115. MyTimer
  116. FortuneTeller
  117. End Sub
  118.  




Here's a little demo (you can see that the quotes are changing at every second, but in the code we have defined it to 5 seconds, but I just changed to 1 so that it could be seen more often the changes)











Two last notes and the more important:

- all these lines of code won't even get executed if you don't give run permissions to macros ^_^''
- Application.OnTime was added in Office2000;





If you have any doubt or found any error, please drop me an email.









clicks: 16504 16504 2008-07-19 2008-07-19 goto mySnippets mySnippets vba  Download  Bookmark This Bookmark This