I have a long running process and need a progress bar. I tried to implement the instructions found here: http://www.excel-easy.com/vba/examples/progress-indicator.html - adapted for my situation.
The form opens, but the progress bar doesn't move and the form shows "Not Responding" even though I use a modeless form. If I step through the process, the form updates as it should.
Any suggestions would be greatly appreciated.
I would guess you are calling DoEvents at the wrong place?
:-\
+1 for DoEvents. I suspect it's not called at all. Just add it in your processing loop. See the example in MSDN:
https://msdn.microsoft.com/en-us/library/office/gg264522.aspx
Actually, I did use Do Events and it still did not work. I followed the example in my link, but used my "counters" to increment the bar. I was getting "Not Responding" and tried other approaches. I'll try again, outside of my main project to see what happens.
Thanks for the quick responses.
Regards,
Johnnie
and now for something in left field!!!
You could do this purely in a shapesheet. Will warn you that it is real real pedantic & tedious
Basically, do the following
- Create 10 squares....lets call them sheet.1 thru sheet.10
- line up in a row
- group them...lets call it sheet.11
- at the group level, use a cell to have value (user cell or props.cell)
- in each child box
sheet.1!fillforegnd = if(sheet.11!user.progress > 0.1, RGB(<on color>, RGB (<off colore>)
sheet.2!fillforegnd = if(sheet.11!user.progress > 0.2, RGB(<on color>, RGB (<off colore>)
sheet.3!fillforegnd = if(sheet.11!user.progress > 0.3, RGB(<on color>, RGB (<off colore>)
etc
So when a value in parent....right rectangles fire
Folks:
I posted a reply elsewhere that might help resolve this one too. Check it out: http://visguy.com/vgforum/index.php?topic=8511.msg38061 (http://visguy.com/vgforum/index.php?topic=8511.msg38061#msg38061)
- Ken
This is what I came up with.
To Show the progress bar
Private Sub showProgressBar()
With frmProgress
.MainBar.Width = 0
.MainText.Caption = "0% Complete"
.SubBar.Width = 0
.SubText.Caption = "0% Complete"
.Show vbModeless
End With
End Sub
To unload the progress bar
Private Sub unloadProgressBar()
Unload frmProgress
End Sub
To increment the Main progress bar
Private Sub IncremenMainProgressBar( _
ByVal thisStep As Long, _
ByVal totProgress As Long)
Dim strCaption
strCaption = "Running Main" & _
" process " & str(thisStep) & _
" of " & str(totProgress)
Dim dblProgress As Double
Dim dblProgressPercentage As Double
Dim lngBarWidth As Long
dblProgress = thisStep / totProgress
With frmProgress
lngBarWidth = .MainBorder.Width * dblProgress
dblProgressPercentage = Round(dblProgress * 100, 0)
.MainProcess.Caption = strCaption
.MainBar.Width = lngBarWidth
.MainText.Caption = dblProgressPercentage & "% Complete"
End With
DoEvents
End Sub
To increment the Sub progress bar
Private Sub IncrementSubProcessBar( _
ByVal thisStep As Long, _
ByVal totProgress As Long)
Dim strCaption
strCaption = "Running Sub" & _
" process " & str(thisStep) & _
" of " & str(totProgress)
Dim dblProgress As Double
Dim dblProgressPercentage As Double
Dim lngBarWidth As Long
dblProgress = thisStep / totProgress
With frmProgress
lngBarWidth = .SubBorder.Width * dblProgress
dblProgressPercentage = Round(dblProgress * 100, 0)
.SubProcess.Caption = strCaption
.SubBar.Width = lngBarWidth
.SubText.Caption = dblProgressPercentage & "% Complete"
g_TotalProcesses = g_TotalProcesses + 1
.TotalProcesses.Caption = "Total Processes Executed: " & Trim(str(g_TotalProcesses))
End With
DoEvents
End Sub
An example of how I call them:
'// Reset global counter used to track the total number of processes executed
g_TotalProcesses = 0
Call showProgressBar
For p = 1 To vsoVisiblePages.Count
'// Increment Process Counter
Call IncremenMainProgressBar( _
p, _
vsoVisiblePages.Count)
Set vsoPage = vsoVisiblePages(p)
'// Get Servers that need to be Commissioned
Set vsoLayer = vsoPage.Layers(C_LYR_COMM)
Set vsoSelection = vsoPage.CreateSelection(visSelTypeByLayer, _
visSelModeSkipSuper, vsoLayer)
For s = 1 To vsoSelection.Count
g_TotalProcesses = g_TotalProcesses + 1
'// Increment Subprocess Counter
Call IncrementSubProcessBar( _
s, _
vsoSelection.Count)
Set vsoShape = vsoSelection(s)
If isShapeServer(vsoShape) = True And vsoShape.LayerCount = 1 Then