如何将宏添加到进度栏

Question

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.

ie 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

Answer 1

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