PetersBase
Programmer
Hi Experts,
I've spent many days searching on the internet for an answer to the following problem:
Using VBA in Excel, start a time consuming task such as an SQL query. While this task is underway, start a Progress Bar that increments with a preset time interval. When this bar reaches the maximum value, it re-sets to zero and starts again in a repetative manner. This is just an indicator that the SQL query task is still being processed. When the task ends, the Progress Bar closes. If the task is part of a "loop", it is easy to make a Progress Bar work in the manner described, by making use of "DoEvents" to free-up some some CPU time to update the Progress Bar. But many tasks do not have a repetative "loop" structure where this command can be inserted. Also I think that VBA does not support multi-tasking? Each task must function sequentially, and can't be run independently in parallel via a different "thread".
Is it possible to create two independent threads using API calls, or some other technique to solve this problem? I have included an example of the code that I'm tying to get to work without DoEvents, because it can't be inserted in some tasks. I am very new to VBA programming for Excel, and a simple solution would be much appreciated. A multi threading technique would "open the door" to other programming challenges. Thank you very much for any advice or help.
I've spent many days searching on the internet for an answer to the following problem:
Using VBA in Excel, start a time consuming task such as an SQL query. While this task is underway, start a Progress Bar that increments with a preset time interval. When this bar reaches the maximum value, it re-sets to zero and starts again in a repetative manner. This is just an indicator that the SQL query task is still being processed. When the task ends, the Progress Bar closes. If the task is part of a "loop", it is easy to make a Progress Bar work in the manner described, by making use of "DoEvents" to free-up some some CPU time to update the Progress Bar. But many tasks do not have a repetative "loop" structure where this command can be inserted. Also I think that VBA does not support multi-tasking? Each task must function sequentially, and can't be run independently in parallel via a different "thread".
Is it possible to create two independent threads using API calls, or some other technique to solve this problem? I have included an example of the code that I'm tying to get to work without DoEvents, because it can't be inserted in some tasks. I am very new to VBA programming for Excel, and a simple solution would be much appreciated. A multi threading technique would "open the door" to other programming challenges. Thank you very much for any advice or help.
Code:
'Code example
'==========================
Private Sub Workbook_Open()
UserForm1.Show False
End Sub
'==========================
'Code in UserForm1
Private Sub CommandButton1_Click()
NextTime = Now + TimeSerial(0, 0, 3) 'Time increment set to 3 secs
Application.OnTime NextTime, "ModuleTick" 'Update Progress Bar in 3 secs
UserForm2.Show False 'Display Form containing Progress Bar
End Sub
Public Sub FormTick() 'Must be called from a Module (ModuleTick)
Call ProgressBar 'Increment the Progress Bar
NextTime = Now + TimeSerial(0, 0, 3)
Application.OnTime NextTime, "ModuleTick" 'Re-call Progress Bar every 3 secs
End Sub
Private Sub CommandButton2_Click() 'Stop Progress Bar via Command Button
Application.OnTime NextTime, "ModuleKillTick"
End Sub
Public Sub FormKillTick() 'Must be called from a Module (ModuleKillTick)
Application.OnTime NextTime, "ModuleTick", , False 'Stop Progress Bar
UserForm2.Hide
Unload UserForm2
End Sub
'=================
'Code in UserForm2
'Dummy Task
Sub UserForm_Activate() 'Start Task
Dim i As Long
i = 1
While i < 10000 And Not blnQuit 'Command Button can end this loop
Worksheets("Sheet1").Cells(i, 1).Activate
Worksheets("Sheet1").Cells(i, 1).Value = "Test Data"
i = i + 1
[COLOR=red]DoEvents[/color red] 'Essential to allow Progress Bar up-date
Wend
Unload UserForm2
End Sub
'==================
Code in Module
Public NextTime As Variant
Public blnQuit As Boolean
Public Sub ModuleTick()
UserForm1.FormTick
End Sub
Public Sub ModuleKillTick()
blnQuit = True 'Stop loop
UserForm1.FormKillTick
End Sub
Public Sub ProgressBar()
UserForm2.Label2.Width = UserForm2.Label2.Width + 10 'Increment Progress Bar
If UserForm2.Label2.Width >= UserForm2.Label1.Width Then
UserForm2.Label2.Width = 0 'Reset Bar
End If
End Sub