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]

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]

Private Sub unloadProgressBar()
    Unload frmProgress
End Sub
To increment the Main progress bar

Code: [Select]

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]

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]

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