VBA Excel 中的进度条
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/5181164/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Progress bar in VBA Excel
提问by darkjh
I'm doing an Excel app that needs a lot data updating from a database, so it takes time. I want to make a progress bar in a userform and it pops up when the data is updating. The bar I want is just a little blue bar moves right and left and repeats till the update is done, no percentage needed.
I know I should use the progressbarcontrol, but I tried for sometime, but can't make it.
我正在做一个 Excel 应用程序，需要从数据库更新大量数据，所以需要时间。我想在用户表单中制作一个进度条，并在数据更新时弹出。我想要的栏只是一个蓝色的小栏，左右移动并重复直到更新完成，不需要百分比。
我知道我应该使用progressbar控件，但我尝试了一段时间，但无法成功。
EDIT: My problem is with the progressbarcontrol, I can't see the bar 'progress'. It just completes when the form pops up. I use a loop and DoEventbut that isn't working. Plus, I want the process to run repeatedly, not just one time.
编辑：我的问题在于progressbar控件，我看不到“进度”栏。它只是在表单弹出时完成。我使用循环，DoEvent但这不起作用。另外，我希望该过程重复运行，而不仅仅是一次。
采纳答案by Matt
In the past, with VBA projects, I've used a label control with the background colored and adjust the size based on the progress. Some examples with similar approaches can be found in the following links:
过去，在 VBA 项目中，我使用带有背景颜色的标签控件并根据进度调整大小。可以在以下链接中找到一些具有类似方法的示例：
- http://oreilly.com/pub/h/2607
- http://www.ehow.com/how_7764247_create-progress-bar-vba.html
- http://spreadsheetpage.com/index.php/tip/displaying_a_progress_indicator/
- http://oreilly.com/pub/h/2607
- http://www.ehow.com/how_7764247_create-progress-bar-vba.html
- http://spreadsheetpage.com/index.php/tip/displaying_a_progress_indicator/
Here is one that uses Excel's Autoshapes:
这是使用 Excel 的 Autoshapes 的一种：
回答by eykanal
Sometimes a simple message in the status bar is enough:
有时状态栏中的一条简单消息就足够了：
This is very simple to implement:
这很容易实现：
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
回答by Zack Graber
Here's another example using the StatusBar as a progress bar.
这是使用 StatusBar 作为进度条的另一个示例。
By using some Unicode Characters, you can mimic a progress bar. 9608 - 9615 are the codes I tried for the bars. Just select one according to how much space you want to show between the bars. You can set the length of the bar by changing NUM_BARS. Also by using a class, you can set it up to handle initializing and releasing the StatusBar automatically. Once the object goes out of scope it will automatically clean up and release the StatusBar back to Excel.
通过使用一些 Unicode 字符，您可以模仿进度条。9608 - 9615 是我为条形尝试的代码。只需根据要在条形之间显示多少空间来选择一个。您可以通过更改 NUM_BARS 来设置条的长度。此外，通过使用类，您可以将其设置为自动处理初始化和释放状态栏。一旦对象超出范围，它将自动清理并将状态栏释放回 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
Sample Usage:
示例用法：
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
回答by John Harris
============== This code goes in Module1 ============
Sub ShowProgress()
UserForm1.Show
End Sub
============== Module1 Code Block End =============
Create a Button on a Worksheet; map button to "ShowProgress" macro
在工作表上创建一个按钮；将按钮映射到“ShowProgress”宏
Create a UserForm1 with 2 buttons, progress bar, bar box, text box:
创建一个带有 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 =============
回答by Lucretius
I'm loving all the solutions posted here, but I solved this using Conditional Formatting as a percentage-based Data Bar.
我喜欢这里发布的所有解决方案，但我使用条件格式作为基于百分比的数据栏解决了这个问题。
This is applied to a row of cells as shown below. The cells that include 0% and 100% are normally hidden, because they're just there to give the "ScanProgress" named range (Left) context.
这适用于一行单元格，如下所示。包含 0% 和 100% 的单元格通常是隐藏的，因为它们只是为了提供“ScanProgress”命名范围（左）上下文。
In the code I'm looping through a table doing some stuff.
在代码中，我在一个表中循环做一些事情。
For intRow = 1 To shData.Range("tblData").Rows.Count
shData.Range("ScanProgress").Value = intRow / shData.Range("tblData").Rows.Count
DoEvents
' Other processing
Next intRow
Minimal code, looks decent.
最少的代码，看起来不错。
回答by Ejaz Ahmed
The label control that resizes is a quick solution. However, most people end up creating individual forms for each of their macros. I used the DoEvents function and a modeless form to use a single form for all your macros.
调整大小的标签控件是一个快速解决方案。然而，大多数人最终会为他们的每个宏创建单独的表单。我使用了 DoEvents 函数和一个无模式表单来为您的所有宏使用一个表单。
Here is a blog post I wrote about it: http://strugglingtoexcel.wordpress.com/2014/03/27/progress-bar-excel-vba/
这是我写的一篇博客文章：http: //strugglingtoexcel.wordpress.com/2014/03/27/progress-bar-excel-vba/
All you have to do is import the form and a module into your projects, and call the progress bar with: Call modProgress.ShowProgress(ActionIndex, TotalActions, Title.....)
您所要做的就是将表单和模块导入到您的项目中，并使用以下命令调用进度条： Call modProgress.ShowProgress(ActionIndex, TotalActions, Title.....)
I hope this helps.
我希望这有帮助。
回答by Keith Swerling
I liked the Status Bar from this page:
我喜欢这个页面的状态栏：
https://wellsr.com/vba/2017/excel/vba-application-statusbar-to-mark-progress/
https://wellsr.com/vba/2017/excel/vba-application-statusbar-to-mark-progress/
I updated it so it could be used as a called procedure. No credit to me.
我更新了它，以便它可以用作被调用的过程。对我没有信用。
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
回答by Krish
Just adding my part to the above collection.
只需将我的部分添加到上述集合中。
If you are after less code and maybe cool UI. Check out my GitHub for Progressbar for VBA
如果您追求更少的代码和可能很酷的 UI。查看我的GitHub for Progressbar for VBA
a customisable one:
一个可定制的：
The Dll is thought for MS-Access but should work in all VBA platform with minor changes. There is also an Excel file with samples. You are free to expand the vba wrappers to suit your needs.
Dll 是为 MS-Access 考虑的，但应该可以在所有 VBA 平台上工作，只需稍作改动。还有一个带有示例的 Excel 文件。您可以自由扩展 vba 包装器以满足您的需要。
This project is currently under development and not all errors are covered. So expect some!
该项目目前正在开发中，并未涵盖所有错误。所以期待一些！
You should be worried about 3rd party dlls and if you are, please feel free to use any trusted online antivirus before implementing the dll.
您应该担心 3rd 方 dll，如果您担心，请在实施 dll 之前随意使用任何可信赖的在线防病毒软件。
回答by ozmike
Hi modified version of another post by Marecki. Has 4 styles
嗨，Marecki的另一篇文章的修改版 。有4种款式
1. dots ....
2 10 to 1 count down
3. progress bar (default)
4. just percentage.
Before you ask why I didn't edit that post is I did and it got rejected was told to post a new answer.
在你问我为什么不编辑那个帖子之前，我做了并且它被拒绝了被告知要发布一个新的答案。
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
回答by PedroMVM
About the progressbarcontrol in a userform, it won't show any progress if you don't use the repaintevent. You have to code this event inside the looping (and obviously increment the progressbarvalue).
关于用户progressbar窗体中的控件，如果您不使用该repaint事件，它将不会显示任何进度。您必须在循环内对此事件进行编码（并且显然会增加progressbar值）。
Example of use:
使用示例：
userFormName.repaint
