VBA Excel中的进度条
我正在做一个Excel应用程序，需要从数据库进行大量数据更新，因此需要时间。 我想在用户窗体中创build一个进度条，并在数据更新时popup。 我想要的酒吧只是一个小小的蓝色酒吧左右移动，并重复，直到更新完成，没有百分比需要。 我知道我应该使用progressbar控件，但我尝试了一段时间，但不能做到这一点。
编辑：我的问题是progressbar控件，我不能看到“进度”栏，它只是当表格popup完成。 我使用一个循环和DoEvent但是这是行不通的。 另外，我想要重复这个过程，而不是一次。
过去，在VBA项目中，我使用了带有背景颜色的标签控件，并根据进度resize。 一些类似的方法可以在以下链接中find：
- 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/
这是一个使用Excel的Autoshapes：
有时在状态栏中有一个简单的消息就足够了：
这非常简单 ：
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是我尝试过的酒吧的代码。 只需根据您要在条形图之间显示多less空间select一个。 您可以通过更改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 =============
在工作表上创build一个button; 映射button到“ShowProgress”macros
用2个button，进度条，栏框，文本框创build一个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 =============
resize的标签控件是一个快速解决scheme。 但是，大多数人最终都会为每个macros创build单独的表单。 我使用了DoEvents函数和一个无模式的表单来为所有的macros使用一个表单。
这里是我写的博客文章： http : //strugglingtoexcel.wordpress.com/2014/03/27/progress-bar-excel-vba/
所有你需要做的就是将表单和一个模块导入到你的项目中，并调用进度条：调用modProgress.ShowProgress（ActionIndex，TotalActions，Title …..）
我希望这有帮助。
我很喜欢这里发布的所有解决scheme，但是我使用条件格式化作为基于百分比的数据栏来解决这个问题。
这适用于一行单元格，如下所示。 包含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
最小的代码，看起来不错。
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
很好的对话框进度条forms，我期待。 来自alainbryden的进度条
使用非常简单，而且看起来不错。
编辑：链接仅适用于高级会员现在：/
这里是很好的另类。
由@eykanal发布的解决scheme可能不是最好的情况下，你有大量的数据处理作为启用状态栏会减慢代码执行。
下面的链接解释了一个很好的方法来build立一个进度条。 高数据量（〜250Klogging+）：
http://www.excel-easy.com/vba/examples/progress-indicator.html
