一个“优雅”的Excel进度条实现方法

声明:此篇中的代码是引用,出处:Progress bar in VBA Excel--stackoverflow

有时候我们在用vba处理excel中的大量计算时,由于程序在后台运行时间比较长,这期间没有任何反馈也无法和Excel交互,用户常常不知道Excel是否还“活着”,这时我们就想给用户显示一个进度条。虽然不管有没有进度条,程序运行的时间不会有变化,但至少能减少用户的焦虑。进度条实现的方式有很多种,网上搜索就可以找到一大把,通常见到的实现方法是使用窗体控件,用图片来模拟进度条。今天想和大家分享的是一个我认为非常优雅别致的方法,一图胜千言,先来看张图:

2016-08-15_162144.png

是不是很“原装”的感觉?

下面就来简单介绍一下实现的思路,其实excel中所有的自己定义的进度条都不是精确的进度,而是我们基于估算来模拟出来的。所以本质上这个进度条并没有不同。它的独特之处在于,没有使用另外的窗体,而是整合于excel下方的状态栏上,用Unicode字符 █ 和 ▏模拟出进度条。好,大体思路就是这样,上代码了:

构造进度条,所有的代码都在一个类模块中:

' Class Module - ProgressBar
Option Explicit

Private statusBarState As Boolean
Private enableEventsState As Boolean
Private screenUpdatingState As Boolean
Private Const NUM_BARS As Integer = 50
Private Const MAX_LENGTH As Integer = 255
Private BAR_CHAR As String
Private SPACE_CHAR As String

Private Sub Class_Initialize()
    ' Save the state of the variables to change
    statusBarState = Application.DisplayStatusBar
    enableEventsState = Application.EnableEvents
    screenUpdatingState = Application.ScreenUpdating
    ' set the progress bar chars (should be equal size)
    BAR_CHAR = ChrW(9608)
    SPACE_CHAR = ChrW(9620)
    ' Set the desired state
    Application.DisplayStatusBar = True
    Application.ScreenUpdating = False
    Application.EnableEvents = False
End Sub

Private Sub Class_Terminate()
    ' Restore settings
    Application.DisplayStatusBar = statusBarState
    Application.ScreenUpdating = screenUpdatingState
    Application.EnableEvents = enableEventsState
    Application.StatusBar = False
End Sub

Public Sub Update(ByVal Value As Long, _
                  Optional ByVal MaxValue As Long = 0, _
                  Optional ByVal Status As String = "", _
                  Optional ByVal DisplayPercent As Boolean = True)

    ' Value          : 0 to 100 (if no max is set)
    ' Value          : >=0 (if max is set)
    ' MaxValue       : >= 0
    ' Status         : optional message to display for user
    ' DisplayPercent : Display the percent complete after the status bar

    ' <Status> <Progress Bar> <Percent Complete>

    ' Validate entries
    If Value < 0 Or MaxValue < 0 Or (Value > 100 And MaxValue = 0) Then Exit Sub

    ' If the maximum is set then adjust value to be in the range 0 to 100
    If MaxValue > 0 Then Value = WorksheetFunction.RoundUp((Value * 100) / MaxValue, 0)

    ' Message to set the status bar to
    Dim display As String
    display = Status & "  "

    ' Set bars
    display = display & String(Int(Value / (100 / NUM_BARS)), BAR_CHAR)
    ' set spaces
    display = display & String(NUM_BARS - Int(Value / (100 / NUM_BARS)), SPACE_CHAR)

    ' Closing character to show end of the bar
    display = display & BAR_CHAR

    If DisplayPercent = True Then display = display & "  (" & Value & "%)  "

    'chop off to the maximum length if necessary
    If Len(display) > MAX_LENGTH Then display = Right(display, MAX_LENGTH)

    Application.StatusBar = display
End Sub

调用进度条的使用示例

Sub ProgBar()

Dim ProgressBar As New ProgressBar

For i = 1 To 30
    Call ProgressBar.Update(i, 100, "正在处理...", True)
    Application.Wait (Now + TimeValue("0:00:01"))
Next

End Sub

再次声明:此篇中的代码均为引用,有细微调整。



知识共享许可协议
除非注明,本博客文章均为原创
并采用知识共享署名-非商业性使用 4.0 国际许可协议进行许可。转载请以URL链接形式标注源地址。

标签: excel, vba

添加新评论