Visio Progress Bar

[OldSchool1948]

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.

[Yacine]

I would guess you are calling DoEvents at the wrong place?

[Nikolay]

+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

[OldSchool1948]

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

[vojo]

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

[Hey Ken]

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

   - Ken

[OldSchool1948]

This is what I came up with.

To Show the progress bar

Code Select Expand


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

Code Select Expand

Private Sub unloadProgressBar()
    Unload frmProgress
End Sub

To increment the Main progress bar

Code Select Expand


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

Code Select Expand


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:

Code Select Expand


    '// 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