logo标签列表

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

excelvba
83

我正在开发一个Excel应用程序，需要从数据库更新大量数据，因此需要一些时间。我想在用户窗体中制作一个进度条，并在数据更新时弹出。我需要的进度条只是一个小蓝色条，向右移动并左右循环直到更新完成，不需要百分比。

我知道应该使用progressbar控件，但我试了一段时间，但无法实现。

我的问题出在progressbar控件上，我看不到进度条的“进度”。它只有在窗体弹出时才完成。我使用了循环和DoEvent，但这并没有起作用。另外，我希望进程重复运行，而不仅仅运行一次。

14个回答
164
有时候，在状态栏中显示一个简单的消息就足够了：

Message in Excel status bar using VBA

这非常容易实现： 请参考此链接。
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
10
很高兴看到这个。对我来说比假装一个进度条要好得多。 - atomicules
2
就像我一样 - 简单而有效。 - Sean
伟大的易于实现的方法。+1 - CaffeinatedMike
1
这个很好用！而且非常简单。但是在关闭屏幕更新时，有没有办法让它工作？现在我只是在状态栏之前打开它，然后在之后关闭它，但我认为这可能会稍微减慢速度。我还在3个独立的for循环中运行它。 - Senor Penguin
不要忘记经常使用DoEvents。否则你的宏将会阻塞用户界面。 - Christopher Oezbek
64

下面是一个使用状态栏(StatusBar)作为进度条的例子。

通过使用一些Unicode字符，你可以模拟进度条。9608-9615是我尝试过的代码，只需根据你想要显示的条之间的空格大小来选择其中一个。你可以通过改变NUM_BARS来设置进度条的长度。同时，通过使用类(class)，你可以设置它来自动处理状态栏的初始化和释放。一旦对象超出范围，它将自动清理并将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
看起来与 Microsoft 用于打开工作簿的类似。 - Sancarn
这个效果出奇的好。使用一个类使得它更简单，因为当调用子程序终止时，状态栏会自动重置（假设您像在示例用法中一样使用局部变量）。感谢分享！ - ChrisB
37
1
@darkjh：不用谢。既然你是新手，请记得如果这个回答解决了你的问题或者有所帮助，请接受并点赞。谢谢。 - Matt
第一个链接不再指向进度条文章。O'Reilly似乎仍然拥有这篇文章，但现在需要创建一个账户：https://www.oreilly.com/library/view/excel-2016-power/9781119067726/c15.xhtml - SSilk
最后一个链接重定向到一个包含大量与Excel相关的技巧和窍门的页面，但我没有看到任何关于进度条的内容。在他们的网站上再也找不到有关这方面的信息了。 - SSilk
13

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

条件格式化

如下图所示，将其应用于一行单元格。包含0％和100％的单元格通常被隐藏，因为它们只是为了给“ScanProgress”命名范围（左侧）提供上下文。

扫描进度

在代码中，我正在循环遍历一个表格并进行一些操作。

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

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

    ' Other processing

Next intRow

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

2
@VoteCoffee DoEvents这一行代码强制屏幕在for循环的每次迭代中更新一次，并允许您在关闭屏幕更新的情况下有选择地触发一次屏幕更新。https://dev59.com/2W865IYBdhLWcg3wl_s3 - Lucretius
一个简洁的解决方案真是美妙！谢谢 - Martin
我想让这个工作起来，但是提供的代码有问题。能否提供一个子程序或更多的说明？更新->按照链接中的说明进行操作。 - Keith Swerling
@KeithSwerling 当您设置数据条时，请确保所有三个单元格都已添加到“条件格式规则管理器”的“适用范围”部分。对于上面显示的三个单元格，它应该是这样的：=$B$2,$C$2,$D$2。0%和100%的单元格仅用于提供“上下文”（最小值和最大值），以便无论在当前显示25%的框中输入什么数字，都会显示相对于该最小值和最大值的部分填充的数据条。如果您将上面的值从100%更改为200%，则25%的数据条将减半。 - Lucretius
10
============== This code goes in Module1 ============
       
Sub ShowProgress()
    UserForm1.Show
End Sub

============== Module1 Code Block End =============
在工作表上创建一个按钮，将按钮映射到“ShowProgress”宏。
创建UserForm1，并添加2个命令按钮和3个标签，以获得以下对象。然后将此代码添加到UserForm1：
======== 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  ' Memorize initial/maximum 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 =====================
8
我喜欢这个页面的状态栏： https://wellsr.com/vba/2017/excel/vba-application-statusbar-to-mark-progress/ 我更新了它，使它可以作为一个可调用的程序使用。与我无关。

Call 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

enter image description here

6
您可以使用VBA创建一个表单，通过代码来增加标签控件的宽度以跟随代码进展。您可以使用标签控件的宽度属性来调整其大小。您可以将标签的背景颜色属性设置为任何您选择的颜色。这将让您创建自己的进度条。
调整大小的标签控件是一种快速解决方案。然而，大多数人最终会为每个宏创建单独的表单。我使用DoEvents函数和无模式表单来为所有宏使用单个表单。
这是我写的一篇博客文章: http://strugglingtoexcel.wordpress.com/2014/03/27/progress-bar-excel-vba/ 您只需将表单和一个模块导入到您的项目中，并使用以下命令调用进度条: Call modProgress.ShowProgress(ActionIndex, TotalActions, Title.....)
希望这能帮到您。
1
我也觉得对话框上的“中止”按钮非常有用，谢谢。 - Thomas Stracke
1
嗨，Thomas。我们都想随时停止循环，这就是我编写代码的原因。谢谢你的注意。祝你有美好的一天。 - Ejaz Ahmed
请访问该网站。这是一个相当大的模块。我已经在那篇文章中解释了代码。 - Ejaz Ahmed
2
关于用户窗体中的progressbar控件，在循环过程中如果没有使用repaint事件，它将不会显示任何进度。你需要在循环内编写此事件（并显然增加progressbar的值）。
使用示例：
userFormName.repaint
1
这是一个我以前没见过的有趣函数。你也可以使用上面讨论过的DoEvents，但我想知道只使用repaint而不是doevents是否能够通过仅执行用户窗体本身而不是所有显示事件来提高执行时间。 - Trashman
2
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
2

仅为以上收集内容增加一部分。

如果您想要更少的代码和可能更酷炫的用户界面，请查看我的GitHub上关于VBA进度条的项目enter image description here

一个可定制的进度条:

enter image description here

这个Dll是针对MS-Access设计的，但只需要进行小改动就可以在所有的VBA平台上使用。还有一个附带着示例的Excel文件。您可以自由地扩展VBA包装器以满足您的需求。

此项目目前正在开发中，并未覆盖所有错误。所以请预计会出现一些问题！

您应该担心第三方DLL，如果有，则可以在实施DLL之前使用任何可信赖的在线杀毒软件。

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接