I know this is an old thread but I had asked a similar question not knowing about this one. I needed an Excel VBA Progress Bar and found this link: Excel VBA StatusBar. Here is a generalized version that I wrote. There are 2 methods, a simple version DisplaySimpleProgressBarStep that defaults to '[|| ] 20% Complete' and a more generalized version DisplayProgressBarStep that takes a laundry list of optional arguments so that you can make it look like just about anything you wish.
Option Explicit
' Resources
' ASCII Chart: https://vbaf1.com/ascii-table-chart/
Private Enum LabelPlacement
None = 0
Prepend
Append
End Enum
#If VBA7 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
#End If
Public Sub Test()
Call ProgressStatusBar(Last:=10)
End Sub
Public Sub Test2()
Const lMilliseconds As Long = 500
Dim lIndex As Long, lNumberOfBars As Long
Dim sBarChar As String
sBarChar = Chr$(133) ' Elipses …
sBarChar = Chr$(183) ' Middle dot ·
sBarChar = Chr$(176) ' Degree sign °
sBarChar = Chr$(171) ' Left double angle «
sBarChar = Chr$(187) ' Right double angle »
sBarChar = Chr$(166) ' Broken vertical bar ¦
sBarChar = Chr$(164) ' Currency sign ¤
sBarChar = Chr$(139) ' Single left-pointing angle quotation mark ‹
sBarChar = Chr$(155) ' Single right-pointing angle quotation mark ›
sBarChar = Chr$(149) ' Bullet •
sBarChar = "|"
For lIndex = 1 To 10
Call DisplayProgressBarStep(lIndex, 10, 50, LabelPlacement.Append, sBarChar)
Call Sleep(lMilliseconds)
Next
Call MsgBox("Status bar test completed.", vbOKOnly Or vbInformation, "Test2 Completed")
Call DisplayProgressBarStep(lIndex, 10, bClearStatusBar:=True)
End Sub
Public Sub Test2Simple()
Const lMilliseconds As Long = 500
Dim lIndex As Long, lNumberOfBars As Long
For lIndex = 1 To 10
Call DisplayProgressBarStep(lIndex, 10, 50)
Call Sleep(lMilliseconds)
Next
Call MsgBox("Status bar test completed.", vbOKOnly Or vbInformation, "Test2Simple Completed")
Call DisplayProgressBarStep(lIndex, 10, bClearStatusBar:=True)
End Sub
''' <summary>
''' Method to display an Excel ProgressBar. Called once for each step in the calling code process.
''' Defaults to vertical bar surrounded by square brackets with a trailing percentage label (e.g. [|||||] 20% Complete).
'''
''' Adapted
''' From: Excel VBA StatusBar
''' Link: https://www.wallstreetmojo.com/vba-status-bar/
''' </summary>
''' <param name="Step">The current step count.</param>
''' <param name="StepCount">The total number of steps.</param>
''' <param name="NumberOfBars">Optional, Number of bars displayed for StepCount. Defaults to StepCount. The higher the number, the longer the string.</param>
''' <param name="LabelPlacement">Optional, Can be None, Prepend or Append. Defaults to Append.</param>
''' <param name="BarChar">Optional, Character that makes up the horizontal bar. Defaults to | (Pipe).</param>
''' <param name="PrependedBoundaryText">Optional, Boundary text prepended to the StatusBar. Defaults to [ (Left square bracket).</param>
''' <param name="AppendedBoundaryText">Optional, Boundary text appended to the StatusBar. Defaults to ] (Right square bracket).</param>
''' <param name="ClearStatusBar">Optional, True to clear the StatusBar. Defaults to False.</param>
Private Sub DisplayProgressBarStep( _
lStep As Long, _
lStepCount As Long, _
Optional lNumberOfBars As Long = 0, _
Optional eLabelPlacement As LabelPlacement = LabelPlacement.Append, _
Optional sBarChar As String = "|", _
Optional sPrependedBoundaryText As String = "[", _
Optional sAppendedBoundaryText As String = "]", _
Optional bClearStatusBar As Boolean = False _
)
Dim lCurrentStatus As Long, lPctComplete As Long
Dim sBarText As String, sLabel As String, sStatusBarText As String
If bClearStatusBar Then
Application.StatusBar = False
Exit Sub
End If
If lNumberOfBars = 0 Then
lNumberOfBars = lStepCount
End If
lCurrentStatus = CLng((lStep / lStepCount) * lNumberOfBars)
lPctComplete = Round(lCurrentStatus / lNumberOfBars * 100, 0)
sLabel = lPctComplete & "% Complete"
sBarText = sPrependedBoundaryText & String(lCurrentStatus, sBarChar) & Space$(lNumberOfBars - lCurrentStatus) & sAppendedBoundaryText
Select Case eLabelPlacement
Case LabelPlacement.None: sStatusBarText = sBarText
Case LabelPlacement.Prepend: sStatusBarText = sLabel & " " & sBarText
Case LabelPlacement.Append: sStatusBarText = sBarText & " " & sLabel
End Select
Application.StatusBar = sStatusBarText
''Debug.Print "CurStatus:"; lCurrentStatus, "PctComplete:"; lPctComplete, "'"; sStatusBarText; "'"
End Sub
''' <summary>
''' Method to display a simple Excel ProgressBar made up of vertical bars | with a trailing label. Called once for each step in the calling code process.
'''
''' Adapted
''' From: Excel VBA StatusBar
''' Link: https://www.wallstreetmojo.com/vba-status-bar/
''' </summary>
''' <param name="Step">The current step count.</param>
''' <param name="StepCount">The total number of steps.</param>
''' <param name="NumberOfBars">Optional, Number of bars displayed for StepCount. Defaults to StepCount. The higher the number, the longer the string.</param>
''' <param name="ClearStatusBar">Optional, True to clear the StatusBar. Defaults to False.</param>
Private Sub DisplaySimpleProgressBarStep( _
lStep As Long, _
lStepCount As Long, _
Optional lNumberOfBars As Long = 0, _
Optional bClearStatusBar As Boolean = False _
)
Call DisplayProgressBarStep(lStep, lStepCount, lNumberOfBars, bClearStatusBar:=bClearStatusBar)
End Sub
