Search code examples
excelstatusbarvba

How to add macro to progress bar


I have this Macro that makes a progress bar in the status bar, but I can not get how to add a macro to it.

i.e if I have a sub, say, Sub LongExacutionTime() how do I apply ShowProgress to it

I tried changing 'Application.Wait Now + TimeValue("00:00:01") '<– Replace this line with your own code to do something to this

Call LongExacutionTimeLongExacutionTime but it executes LongExacutionTimeLongExacutionTime 10 times (once for each iteration of the loop)

This seems like it should be simple to get and maybe it is but I am not getting it

any insight into this is appriciated

Thanks

Sub ShowProgress()
Dim strBar As String
Dim lngLoop As Long


'make StatusBar visible
Application.DisplayStatusBar = True
strBar = String(0, ChrW(&H25A0)) & String(10, ChrW(&H25A1))
Application.StatusBar = strBar & "Starting…"
Application.Wait Now + TimeValue("00:0:01")

 For lngLoop = 1 To 1
     strBar = String(lngLoop, ChrW(&H25A0)) & String(10 - lngLoop, ChrW(&H25A1))
     Application.StatusBar = strBar & " Processing…"
    'Application.Wait Now + TimeValue("00:00:01") '<– Replace this line with your own   code to do something        
   Next

'Relinquish the StatusBar
Application.StatusBar = False
End Sub

Solution

  • I think you're looking for something like this:

    Sub ShowProgress(strMessage As String)
    
        'make StatusBar visible
        Application.DisplayStatusBar = True
        Application.StatusBar = strMessage
    
    End Sub
    
    Public Sub LongExecutionTime()
    
        'About to start
        Call ShowProgress("Starting...")
    
        'Run some other code.  I've put a wait of 5 seconds in so you can see the status bar saying "Starting..."
        Application.Wait Now + TimeValue("00:00:05")
        'Process some stuff
        Call ShowProgress("Processing...")
    
        'Run some other code.  I've put a wait of 5 seconds in so you can see the status bar saying "Processing..."
        Application.Wait Now + TimeValue("00:00:05")
    
        Call ShowProgress("FinishingUp..")
        'Same wait
        Application.Wait Now + TimeValue("00:00:05")
    
        'Turn off StatusBar
        Application.DisplayStatusBar = False
    
    End Sub