Author Topic: Visio Progress Bar  (Read 2650 times)

0 Members and 1 Guest are viewing this topic.

OldSchool1948

  • Jr. Member
  • **
  • Posts: 45
Visio Progress Bar
« on: February 01, 2017, 11:21:22 AM »
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

  • Hero Member
  • *****
  • Posts: 2596
Re: Visio Progress Bar
« Reply #1 on: February 01, 2017, 01:40:53 PM »
I would guess you are calling DoEvents at the wrong place?
 :-\
Yacine

Nikolay

  • Hero Member
  • *****
  • Posts: 789
    • UnmanagedVisio
Re: Visio Progress Bar
« Reply #2 on: February 01, 2017, 03:05:55 PM »
+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

  • Jr. Member
  • **
  • Posts: 45
Re: Visio Progress Bar
« Reply #3 on: February 01, 2017, 03:57:32 PM »
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

  • Hero Member
  • *****
  • Posts: 1251
Re: Visio Progress Bar
« Reply #4 on: February 03, 2017, 10:01:34 AM »
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

  • Full Member
  • ***
  • Posts: 192
  • Just This Guy
    • The Pennsylvania Project, with Ken Krawchuk
Re: Visio Progress Bar
« Reply #5 on: February 13, 2019, 03:47:32 PM »
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

Ken V. Krawchuk
'caster

The Pennsylvania Project
Radio Podcast

10 to 11 AM Saturdays on WWDB 860 AM in Philadelphia
On demand at http://PennsylvaniaProject.com

OldSchool1948

  • Jr. Member
  • **
  • Posts: 45
Re: Visio Progress Bar
« Reply #6 on: March 26, 2019, 08:15:08 PM »
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