如何在Excel VBA中创建进度栏？

我正在做一个Excel应用程序，需要从数据库中更新大量数据，因此需要时间。我想在用户窗体中创建一个进度条，并在数据更新时弹出。我想要的条形图只是一个蓝色的小条形图，它左右左右移动，重复直到更新完成，不需要任何百分比。

我知道我应该使用该progressbar控件，但是我尝试了一段时间，但无法成功。

我的问题是progressbar控件，看不到“进度”栏。当表格弹出时，它就完成了。我使用一个循环，DoEvent但是没有用。另外，我希望该过程可以重复运行，而不仅仅是一次。

过去，在VBA项目中，我使用了带有背景颜色的标签控件，并根据进度调整大小。在以下链接中可以找到一些采用类似方法的示例：

1. http://oreilly.com/pub/h/2607
2. http://www.ehow.com/how_7764247_create-progress-bar-vba.html
3. http://spreadsheetpage.com/index.php/tip/displaying_a_progress_indicator/

这是使用Excel的自动形状的一种：

http://www.andypope.info/vba/pmeter.htm

有时，状态栏中的一条简单消息就足够了：

这很容易实现：

Dim x               As Integer 
Dim MyTimer         As Double 

'Change this loop as needed.
For x = 1 To 50
    ' Do stuff
    Application.StatusBar = "Progress: " & x & " of 50: " & Format(x / 50, "0%")
Next x 

Application.StatusBar = False

这是使用StatusBar作为进度条的另一个示例。

通过使用一些Unicode字符，您可以模仿进度条。9608-9615是我尝试过的条码。只需根据要在条之间显示多少空间选择一个即可。您可以通过更改NUM_BARS来设置钢筋的长度。同样，通过使用一个类，您可以将其设置为自动处理StatusBar的初始化和释放。一旦对象超出范围，它将自动清理并将StatusBar释放回Excel。

' 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

用法示例：

Dim progressBar As New ProgressBar

For i = 1 To 100
    Call progressBar.Update(i, 100, "My Message Here", True)
    Application.Wait (Now + TimeValue("0:00:01"))
Next

============== This code goes in Module1 ============

Sub ShowProgress()
    UserForm1.Show
End Sub

============== Module1 Code Block End =============

在工作表上创建一个按钮；将按钮映射到“ ShowProgress”宏

创建一个带有2个按钮，进度条，条形框，文本框的UserForm1：

UserForm1 = canvas to hold other 5 elements
CommandButton2 = Run Progress Bar Code; Caption:Run
CommandButton1 = Close UserForm1; Caption:Close
Bar1 (label) = Progress bar graphic; BackColor:Blue
BarBox (label) = Empty box to frame Progress Bar; BackColor:White
Counter (label) = Display the integers used to drive the progress bar

======== Attach the following code to UserForm1 =========

Option Explicit

' This is used to create a delay to prevent memory overflow
' remove after software testing is complete

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub UserForm_Initialize()

    Bar1.Tag = Bar1.Width
    Bar1.Width = 0

End Sub
Sub ProgressBarDemo()
    Dim intIndex As Integer
    Dim sngPercent As Single
    Dim intMax As Integer
    '==============================================
    '====== Bar Length Calculation Start ==========

    '-----------------------------------------------'
    ' This section is where you can use your own    '
    ' variables to increase bar length.             '
    ' Set intMax to your total number of passes     '
    ' to match bar length to code progress.         '
    ' This sample code automatically runs 1 to 100  '
    '-----------------------------------------------'
    intMax = 100
    For intIndex = 1 To intMax
        sngPercent = intIndex / intMax
        Bar1.Width = Int(Bar1.Tag * sngPercent)
        Counter.Caption = intIndex


    '======= Bar Length Calculation End ===========
    '==============================================


DoEvents
        '------------------------
        ' Your production code would go here and cycle
        ' back to pass through the bar length calculation
        ' increasing the bar length on each pass.
        '------------------------

'this is a delay to keep the loop from overrunning memory
'remove after testing is complete
        Sleep 10

    Next

End Sub
Private Sub CommandButton1_Click() 'CLOSE button

Unload Me

End Sub
Private Sub CommandButton2_Click() 'RUN button

        ProgressBarDemo

End Sub

================= UserForm1 Code Block End =====================

============== This code goes in Module1 =============

Sub ShowProgress()
    UserForm1.Show
End Sub

============== Module1 Code Block End =============

我喜欢这里发布的所有解决方案，但是我使用条件格式作为基于百分比的数据栏解决了这个问题。

如下所示，这将应用于一行单元格。通常将包含0％和100％的单元格隐藏起来，因为它们只是在此处提供“ ScanProgress”命名范围（Left）上下文。

在代码中，我遍历一个表在做一些事情。

For intRow = 1 To shData.Range("tblData").Rows.Count

    shData.Range("ScanProgress").Value = intRow / shData.Range("tblData").Rows.Count
    DoEvents

    ' Other processing

Next intRow

最少的代码，看起来不错。

我喜欢此页面上的状态栏：

https://wellsr.com/vba/2017/excel/vba-application-statusbar-to-mark-progress/

我对其进行了更新，因此可以将其用作调用过程。不要相信我

showStatus Current, Total, "  Process Running: "

Private Sub showStatus(Current As Integer, lastrow As Integer, Topic As String)
Dim NumberOfBars As Integer
Dim pctDone As Integer

NumberOfBars = 50
'Application.StatusBar = "[" & Space(NumberOfBars) & "]"


' Display and update Status Bar
    CurrentStatus = Int((Current / lastrow) * NumberOfBars)
    pctDone = Round(CurrentStatus / NumberOfBars * 100, 0)
    Application.StatusBar = Topic & " [" & String(CurrentStatus, "|") & _
                            Space(NumberOfBars - CurrentStatus) & "]" & _
                            " " & pctDone & "% Complete"

' Clear the Status Bar when you're done
'    If Current = Total Then Application.StatusBar = ""

End Sub

调整大小的标签控件是一种快速的解决方案。但是，大多数人最终会为其每个宏创建单独的表单。我使用了DoEvents函数和无模式形式来对所有宏使用单一形式。

这是我写过的一篇博客文章：http : //strugglingtoexcel.wordpress.com/2014/03/27/progress-bar-excel-vba/

您要做的就是将表单和模块导入项目，然后使用以下命令调用进度栏：调用modProgress.ShowProgress（ActionIndex，TotalActions，Title .....）

我希望这有帮助。

Sub ShowProgress()
' Author    : Marecki
  Const x As Long = 150000
  Dim i&, PB$

  For i = 1 To x
    PB = Format(i / x, "00 %")
    Application.StatusBar = "Progress: " & PB & "  >>" & String(Val(PB), Chr(183)) & String(100 - Val(PB), Chr(32)) & "<<"
    Application.StatusBar = "Progress: " & PB & "  " & ChrW$(10111 - Val(PB) / 11)
    Application.StatusBar = "Progress: " & PB & "  " & String(100 - Val(PB), ChrW$(9608))
  Next i

  Application.StatusBar = ""
End SubShowProgress

嗨Marecki的另一个帖子的修改版本 。有4种样式

1. dots ....
2  10 to 1 count down
3. progress bar (default)
4. just percentage.

在您问为什么我不编辑该帖子之前，我被告知要发布新答案。

Sub ShowProgress()

  Const x As Long = 150000
  Dim i&, PB$

  For i = 1 To x
  DoEvents
  UpdateProgress i, x
  Next i

  Application.StatusBar = ""
End Sub 'ShowProgress

Sub UpdateProgress(icurr As Long, imax As Long, Optional istyle As Integer = 3)
    Dim PB$
    PB = Format(icurr / imax, "00 %")
    If istyle = 1 Then ' text dots >>....    <<'
        Application.StatusBar = "Progress: " & PB & "  >>" & String(Val(PB), Chr(183)) & String(100 - Val(PB), Chr(32)) & "<<"
    ElseIf istyle = 2 Then ' 10 to 1 count down  (eight balls style)
        Application.StatusBar = "Progress: " & PB & "  " & ChrW$(10111 - Val(PB) / 11)
    ElseIf istyle = 3 Then ' solid progres bar (default)
        Application.StatusBar = "Progress: " & PB & "  " & String(100 - Val(PB), ChrW$(9608))
    Else ' just 00 %
        Application.StatusBar = "Progress: " & PB
    End If
End Sub

关于用户progressbar窗体中的控件，如果您不使用该repaint事件，它将不会显示任何进度。您必须在循环内编写此事件的代码（并明显增加该progressbar值）。

使用示例：

userFormName.repaint

只需将我的部分添加到上述集合中即可。

如果您只需要较少的代码，可能还不错的UI。查看我的GitHub以获取VBA的Progressbar

可定制的：

Dll被认为是用于MS-Access，但应该在所有VBA平台中进行较小的更改即可工作。还有一个带有示例的Excel文件。您可以自由扩展vba包装器以适合您的需求。

该项目目前正在开发中，并未涵盖所有错误。所以期待一些！

您应该担心第三方dll，如果您愿意，请在实施dll之前随意使用任何受信任的在线防病毒软件。

还有很多其他很棒的文章，但是我想说的是，理论上您应该能够创建一个REAL进度条控件：

1. 使用CreateWindowEx()创建进度条

一个C ++示例：

hwndPB = CreateWindowEx(0, PROGRESS_CLASS, (LPTSTR) NULL, WS_CHILD | WS_VISIBLE, rcClient.left,rcClient.bottom - cyVScroll,rcClient.right, cyVScroll,hwndParent, (HMENU) 0, g_hinst, NULL);

hwndParent应该设置为父窗口。为此，可以使用状态栏或自定义表单！这是从Spy ++中找到的Excel的窗口结构：

因此，使用FindWindowEx()功能应该相对简单。

hwndParent = FindWindowEx(Application.hwnd,,"MsoCommandBar","Status Bar")

创建进度条后，您必须用于SendMessage()与进度条进行交互：

Function MAKELPARAM(ByVal loWord As Integer, ByVal hiWord As Integer)
    Dim lparam As Long
    MAKELPARAM = loWord Or (&H10000 * hiWord)
End Function

SendMessage(hwndPB, PBM_SETRANGE, 0, MAKELPARAM(0, 100))
SendMessage(hwndPB, PBM_SETSTEP, 1, 0)
For i = 1 to 100
    SendMessage(hwndPB, PBM_STEPIT, 0, 0) 
Next
DestroyWindow(hwndPB)

我不确定该解决方案的实用性，但是它看起来比这里介绍的其他方法更“官方”。

您可以添加一个Form并将其命名为Form1，也向其中添加一个Frame作为Frame1以及Label1。将Frame1宽度设置为200，将“背景色”设置为蓝色。将代码放在模块中，然后检查是否有帮助。

    Sub Main()
    Dim i As Integer
    Dim response
    Form1.Show vbModeless
    Form1.Frame1.Width = 0
    For i = 10 To 10000
        With Form1
            .Label1.Caption = Round(i / 100, 0) & "%"
            .Frame1.Width = Round(i / 100, 0) * 2
             DoEvents
        End With
    Next i

    Application.Wait Now + 0.0000075

    Unload Form1

    response = MsgBox("100% Done", vbOKOnly)

    End Sub

如果要显示在状态栏上，则可以使用其他更简单的方法：

   Sub Main()
   Dim i As Integer
   Dim response
   For i = 10 To 10000
        Application.StatusBar = Round(i / 100, 0) & "%"
   Next i

   Application.Wait Now + 0.0000075

   response = MsgBox("100% Done", vbOKOnly)

   End Sub