VBA Excel中的进度条

Question

我正在做一个需要从数据库进行大量数据更新的Excel应用程序,因此需要时间.我想在userform中创建一个进度条,它会在数据更新时弹出.我想要的酒吧只是一个小的蓝色条左右移动并重复,直到更新完成,不需要百分比.我知道我应该使用progressbar控件,但我曾尝试过一段时间,但是无法做到.

编辑:我的问题是progressbar控件,我看不到栏'进展',它只是在表格弹出时完成.我使用循环,DoEvent但这不起作用.另外,我希望这个过程重复,而不仅仅是一次.

Answer 1

有时,状态栏中的简单消息就足够了:

这很容易实现:

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

Answer 2

这是使用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

Answer 3

在过去,对于VBA项目,我使用了背景色的标签控件,并根据进度调整大小.可以在以下链接中找到具有类似方法的一些示例:

1. http://oreilly.com/pub/h/2607
2. http://www.ehow.com/how_7764247_create-progress-bar-vba.html
3. http://spreadsheetpage.com/index.php/tip/displaying_a_progress_indicator/

这是一个使用Excel的Autoshapes:

http://www.andypope.info/vba/pmeter.htm

Answer 4

============== 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 =============

Answer 5

我喜欢这里发布的所有解决方案,但我使用条件格式作为基于百分比的数据栏解决了这个问题.

这适用于一行单元格,如下所示.包含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

最小的代码,看起来不错.

Answer 6

我喜欢这个页面的状态栏：

https://wellsr.com/vba/2017/excel/vba-application-statusbar-to-mark-progress/

我更新了它，以便它可以用作被调用的过程。对我没有信用。

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

Answer 7

调整大小的标签控件是一种快速解决方案.但是,大多数人最终会为每个宏创建单独的表单.我使用DoEvents函数和无模式表单为所有宏使用单个表单.

这是我写的关于它的博客文章:http://strugglingtoexcel.wordpress.com/2014/03/27/progress-bar-excel-vba/

您所要做的就是将表单和模块导入到项目中,并使用以下方法调用进度条:调用modProgress.ShowProgress(ActionIndex,TotalActions,Title .....)

我希望这有帮助.