Progress bar and Status bar.

[omairhe]

Hello all,

How can I use the status bar at the bottom to be used as a progress bar for notifying the end-user to wait until vba completes running in the background. So far I have experimented a little with unicode character ChrW(9616) and liked the results. With my novice vba know how I can't make it to progress though. Thus will appreciate a lot any feedback on this. The following is the code I use

Sub progbar()
Dim Lst
I = ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616) & ChrW(9616)
Application.StatusBar = Lst
End Sub

After running the code I get the same as the image...

So how do I change the code to make this into an animated progress bar. I believe the status bar has room for 100 character and the current characters count is somewhere around 30. What if I want to progress it by 5 characters every N seconds til I reach 100th character and the end of my code at the same time?? I will have to make an estimate. So if my code takes 40 seconds to run the N will need to be 2.5 seconds .

Anyone please want to give it a try?

 

[Jaafar Tribak]

Something like this maybe:

Sub progbar()

    Dim Lst As String, i As Long
   
    Application.StatusBar = False
        For i = 1 To 20
            Lst = String(i * 5, ChrW(9616))
            Application.StatusBar = CStr(Lst)
            Delay 2.5
        Next i
    Application.StatusBar = False

End Sub

Private Sub Delay(ByVal Secs As Long)

    Dim sngTimer As Single
   
    sngTimer = Timer
    Do
        DoEvents
    Loop Until Timer - sngTimer >= Secs

End Sub

 

[omairhe]

Something like this maybe:

Sub progbar()

    Dim Lst As String, i As Long
 
    Application.StatusBar = False
        For i = 1 To 20
            Lst = String(i * 5, ChrW(9616))
            Application.StatusBar = CStr(Lst)
            Delay 2.5
        Next i
    Application.StatusBar = False

End Sub

Private Sub Delay(ByVal Secs As Long)

    Dim sngTimer As Single
 
    sngTimer = Timer
    Do
        DoEvents
    Loop Until Timer - sngTimer >= Secs

End Sub

Thank you Jaafar.
This works nicely. Really appreciate you giving your time and expertise.

 

[Jaafar Tribak]

@omairhe

Glad I could help.

You could pass the arguments to a generic routine for more flexibility as follows:

Sub RunProgressBar(ByVal DispCharacter As String, ByVal Step As Integer, ByVal MaxLength As Integer, ByVal Delay As Single)

    Dim i As Integer, sngTimer As Single
   
    If Step > MaxLength Then GoTo errHandler
    Step = Abs(Step)

    Application.StatusBar = False
        For i = 1 To MaxLength \ Step
            Application.StatusBar = String(i * Step, DispCharacter)
            sngTimer = Timer
            Do
                DoEvents
            Loop Until Timer - sngTimer >= Abs(Delay)
        Next i
    Application.StatusBar = False
   
    Exit Sub
   
errHandler:
   
    MsgBox "Step must be <= than MaxLength ", , "Error"

End Sub

An then you call it like this :

Sub progbar()

    RunProgressBar ChrW(9616), 5, 100, 2.5

End Sub

 

[omairhe]

@omairhe

Glad I could help.

You could pass the arguments to a generic routine for more flexibility as follows:

Sub RunProgressBar(ByVal DispCharacter As String, ByVal Step As Integer, ByVal MaxLength As Integer, ByVal Delay As Single)

    Dim i As Integer, sngTimer As Single
  
    If Step > MaxLength Then GoTo errHandler
    Step = Abs(Step)

    Application.StatusBar = False
        For i = 1 To MaxLength \ Step
            Application.StatusBar = String(i * Step, DispCharacter)
            sngTimer = Timer
            Do
                DoEvents
            Loop Until Timer - sngTimer >= Abs(Delay)
        Next i
    Application.StatusBar = False
  
    Exit Sub
  
errHandler:
  
    MsgBox "Step must be <= than MaxLength ", , "Error"

End Sub

An then you call it like this :

Sub progbar()

    RunProgressBar ChrW(9616), 5, 100, 2.5

End Sub

I try your code with running my code but it seems that Excel can't run both the codes at the same time. First it will run yours and after completing the script it runs the next script.
Is there a way around this or perhaps somewhere I missed the point?

 

[Jaafar Tribak]

If you run the code in post#4 then don't run the code in post#2... Either you use the code in post#2 or the code in post#4 ... You can't run both codes at the same time.

 

[mariahcarey]

Hello all
I was looking at the question and the solutions, this would completely improve a group report I have... But I am seem to be missing a step, or don't know where to put it. It doesn't do anything in my file. I disabled some msg boxes I had at workbook open, also tried in a module or "inthisworkbook" but I am clearly too dummy to make this work