我正在做一个需要从数据库更新大量数据的Excel应用程序,因此需要时间。我想在userform中创建一个进度条,它会在数据更新时弹出。我想要的酒吧只是一个小的蓝色条左右移动并重复,直到更新完成,不需要百分比。
我知道我应该使用progressbar
控件,但我曾尝试过一段时间,但是无法控制它。
编辑:我的问题在于progressbar
控件,我看不到栏'进度'。它只是在表单弹出时完成。我使用循环和DoEvent
,但这不起作用。另外,我希望这个过程能够反复运行,而不仅仅是一次。
答案 0 :(得分:132)
有时,状态栏中的简单消息就足够了:
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
答案 1 :(得分:54)
这是使用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
答案 2 :(得分:36)
过去,在VBA项目中,我使用了背景色的标签控件,并根据进度调整大小。可以在以下链接中找到具有类似方法的一些示例:
答案 3 :(得分:9)
============== 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 =============
答案 4 :(得分:6)
调整大小的标签控件是一种快速解决方案。但是,大多数人最终会为每个宏创建单独的表单。我使用DoEvents函数和无模式表单为所有宏使用单个表单。
以下是我撰写的关于它的博文:http://strugglingtoexcel.wordpress.com/2014/03/27/progress-bar-excel-vba/
您所要做的就是将表单和模块导入到项目中,并使用以下方法调用进度条:调用modProgress.ShowProgress(ActionIndex,TotalActions,Title .....)
我希望这会有所帮助。
答案 5 :(得分:6)
我喜欢这里发布的所有解决方案,但我使用条件格式作为基于百分比的数据栏解决了这个问题。
这适用于一行单元格,如下所示。包含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
最小的代码,看起来不错。
答案 6 :(得分: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
答案 7 :(得分:2)
嗨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
答案 8 :(得分:2)
关于用户表单中的progressbar
控件,如果您不使用repaint
事件,则不会显示任何进度。您必须在循环内对此事件进行编码(显然会增加progressbar
值)。
使用示例:
userFormName.repaint
答案 9 :(得分:1)
还有很多其他很棒的帖子,但是我想说理论上你应该能够创建一个 REAL 进度条控件:
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)
我不确定这个解决方案有多实用,但它可能看起来更像“官方”#39;比这里所述的其他方法。
答案 10 :(得分:1)
只需将我的部分添加到上面的集合中。
如果你的代码较少,也可能是很酷的用户界面。看看我的GitHub for Progressbar for VBA
可自定义的:
Dll被认为是MS-Access,但应该可以在所有VBA平台上进行微小的更改。还有一个包含样本的Excel文件。您可以自由扩展vba包装器以满足您的需求。
该项目目前正在开发中,并未涵盖所有错误。所以期待一些!
你应该担心第三方dll,如果你是,请在实施dll之前随意使用任何可信的在线杀毒软件。
答案 11 :(得分:1)
我喜欢此页面上的状态栏:
https://wellsr.com/vba/2017/excel/vba-application-statusbar-to-mark-progress/
我对其进行了更新,因此可以将其用作调用过程。不信我。
print(dd2dms(12.345678))
result: [12,20,44.4407...]
答案 12 :(得分:0)
答案 13 :(得分:0)
@eykanal发布的解决方案可能不是最好的,因为您需要处理大量数据,因为启用状态栏会降低代码执行速度。
以下链接解释了构建进度条的好方法。适用于高数据量(约250K记录+):
http://www.excel-easy.com/vba/examples/progress-indicator.html
答案 14 :(得分:0)
您可以添加一个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