我正在做一个Excel应用程序，需要从数据库更新大量数据，因此需要时间。我想在用户窗体中创建一个进度条，并在数据更新时弹出。我想要的酒吧只是一个小小的蓝色酒吧左右移动，并重复，直到更新完成，没有百分比需要。 我知道我应该使用progressbar控制，但我尝试了一段时间，但不能做到这一点。VBA中的进度条Excel
编辑：我的问题是与progressbar控制，我不能看到“进度”栏，它只是当表格弹出时完成。我使用循环和DoEvent但这不起作用。另外，我希望重复这个过程，而不是一次。
过去，在VBA项目中，我使用了带背景颜色的标签控件，并根据进度调整大小。用类似的方法的一些例子可以在下面的链接中找到：
下面是一个使用Excel的自选图形：
============== This code goes in Module1 ============
Sub ShowProgress()
UserForm1.Show
End Sub
============== Module1 Code Block End =============
在工作表上创建一个按钮;
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 =============
这是一个不错的解决方案！ – Stephan
有时在状态栏一个简单的信息就足够了：
地图按钮“ShowProgress”宏观
，2个按钮，进度栏，栏框，文本框创建UserForm1
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
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
调整大小的标签控件是一个快速解决方案。但是，大多数人最终都会为每个宏创建单独的表单。我使用了DoEvents函数和一个无模式的表单来为所有的宏使用单一表单。
这里是一个博客帖子我写这件事：http://strugglingtoexcel.wordpress.com/2014/03/27/progress-bar-excel-vba/
所有你需要做的是进口形式和模块到你的项目，并调用进度条：呼叫modProgress.ShowProgress（的actionIndex，TotalActions ，标题.....）
我希望这有助于。
我还发现对话框中的“中止”按钮非常有帮助，谢谢。 –
嗨托马斯。我们都希望随意停止循环，这就是为什么我编码。感谢您注意。祝你有美好的一天。 –
我很喜欢这里发布的所有解决方案，但我使用条件格式作为基于百分比的数据栏来解决此问题。如下所示
这适用于单元的行。包含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
最小的代码，看起来不错。
我用这种方法看到的主要问题是，当我正在执行使进度条有用的大型操作时，我经常关闭屏幕更新和计算。 – VoteCoffee
其他职位的修改版本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
解决方案发表@eykanal可能不会在情况最好的，你有大量的数据处理为启用状态栏会减慢代码执行。
以下链接解释了构建进度条的一种很好的方法。 - 告诉我们您已经成功地做什么，有什么问题，我们
http://www.excel-easy.com/vba/examples/progress-indicator.html
“尝试了一段时间，但不能让它”：以高数据量（〜250K +记录），效果很好我会尽力帮助你 –
thx的建议，请参阅编辑 – darkjh