在循环内使用状态栏答案

【问题标题】：Working with status bars inside of a loop在循环内使用状态栏
【发布时间】：2022-08-18 02:37:14
【问题描述】：

我正在努力让我的状态栏与我的循环正常工作。我正在使用application.screenupdating = false，这样人们就不会看到我的过程实际上有多混乱。但由于它正在运行，它可能需要 2-5 分钟才能完成。我尝试使用教程中的代码来显示进度，但它立即跳转到 100%，而不是跟踪循环数。

Public Sub ProduceReports()
    Dim a As Range
    Dim StartingWS As Worksheet
    Dim ClientFolder As String
    Dim ClientCusip
    Dim ExportFile As String
    Dim PreparedDate As String
    Dim Exports As String
    Dim AccountNumber As String
    Dim LR As Long
    Dim NumOfBars As Integer
    Dim PresentStatus As Integer
    Dim PercetageCompleted As Integer
    Dim k As Long
    \'******** This is my status bar code*******************
    LR = Cells(Rows.Count, 1).End(xlUp).row
    NumOfBars = 45
    Application.StatusBar = \"[\" & Space(NumOfBars) & \"]\"
    For k = 1 To LR

        PresentStatus = Int((k / LR) * NumOfBars)
        PercetageCompleted = Round(PresentStatus / NumOfBars * 100, 0)

        Application.StatusBar = \"[\" & String(PresentStatus, \"|\") & Space(NumOfBars - PresentStatus) & \"] \" & PercetageCompleted & \"% Complete\"

        DoEvents
    
        Cells(k, 1).Value = k
      
        Set StartingWS = ThisWorkbook.Sheets(\"Starting Page\")
        
        \'************* This code creates the folder and sets the export path for the individual spreadsheets**********
        ClientCusip = ActiveWorkbook.Worksheets(\"Starting Page\").Range(\"I11\").Value
        ClientFolder = ActiveWorkbook.Worksheets(\"Starting Page\").Range(\"I10\").Value
        PreparedDate = Format(Now, \"mm.yyyy\")
        MkDir \"P:\\DEN-Dept\\Public\\\" & ClientFolder & \" - \" & ClientCusip & \" - \" & PreparedDate
        ExportFile = \"P:\\DEN-Dept\\Public\\\" & ClientFolder & \" - \" & ClientCusip & \" - \" & PreparedDate & \"\\\"
        Exports = ExportFile
    
        Worksheets(\"Standby\").Visible = True
        Sheets(\"Standby\").Activate
        Application.screenUpdating = False
        
        \'************* This is the loop to check the cells and set the offset value as elgible or ineligible**********
        For Each a In StartingWS.Range(\"G9:G29\").Cells
            If a.Value = \"Eligible\" Then
                AccountNumber = a.Offset(0, -1).Value
                PrepareClassSheets AccountNumber, Exports
            End If
        Next a
        
        Sheets(\"Starting Page\").Activate
        Application.screenUpdating = True
        Worksheets(\"Standby\").Visible = False
         
        MsgBox Prompt:=\"Class Action Data for\" & \" \" & ClientFolder & \" \" & \"has been prepared.\", Title:=\"Bear has completed his tasks.\"
             
        Call Shell(\"explorer.exe\" & \" \" & ExportFile, vbNormalFocus)
          
        \'************** End of the status bar*********
        If k = LR Then Application.StatusBar = False
        
    Next k
      
End Sub

我想我想如果我在另一个循环之外关闭状态栏循环，它会起作用。我在这里遗漏了一些明显的东西吗？

当我将您的代码简化为仅进度条部分时，它对我来说效果很好（只有这样我才能测试它）。 LR（你的最后一个行号）在你第一次设置的时候是什么值？如果您通过代码调试步骤，进度条是否也不会显示？
我的 LR 设置为 45，只是因为这就是示例所具有的。进度条出现了，但假设在 G9:G29 之间有 8 个符合条件的帐户，在循环开始之前它就达到了 100。所以它似乎无法判断它是一个循环中的一个循环。
在一个将在几分钟内完成的过程中，它会立即以 100% 的速度开始吗？
要“检查”StatusBar 进程的中间值，请将这行代码放在“DoEvents”之前，运行代码并打开（必要时按CTRL+G）即时窗口以查看这些中间值。也许你可以得出一些结论。另一个想法是，也许另一个函数正在同时处理状态栏。你能检查一下名为 \'PrepareClassSheets\' 的子例程是否也使用它吗？... 代码：Debug.Print Now, k, LR, Application.StatusBar

标签： excel vba loops statusbar

【解决方案1】：

我试图重现您的进度条未更新的情况，但无法这样做。

但是，我将您的进度条更新程序重构为它自己的子例程，并创建了一个测试子程序来测试该部分代码的工作方式。此外，我添加了sleep API，以便我们可以看到正在运行的进度条。

在我的测试中，这一切似乎都很好。

编码

这是我用于新子和测试子的sleep API。

' Stop code execution for specified milliseconds
' Add this for the new sub as well as the testing sub.
#If VBA7 And Win64 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

下面是更新您的进度条的子。

' This sub uses the Global Status Bar as
' a progress bar.
Public Sub UpdateProgressStatusBar( _
    currentStep As Long, _
    totalSteps As Long, _
    Optional numberOfBars As Long = 100 _
)
    Dim presentStatus As Long
    presentStatus = CLng((currentStep / totalSteps) * numberOfBars)
    
    Dim percetageCompleted As Long
    percetageCompleted = Round(presentStatus / numberOfBars * 100, 0)
        
    Application.StatusBar = "[" & String(presentStatus, "|") & _
        Space(numberOfBars - presentStatus) & "] " & _
        percetageCompleted & "% Complete"
        
    ' I don't think this is needed, but I'm not 100% sure
    DoEvents
       
    ' When Progress is 100% we need to
    ' clear the progress bar. Adding a sleep
    ' to this step to make it a better user
    ' experince giving them a chance to see
    ' it is complete.
    If currentStep >= totalSteps Then
        Sleep 300
        Application.StatusBar = False
    End If
End Sub

最后，这是测试潜艇。您可以使用它来查看它是否适用于您的系统，并向其添加场景以查看您是否可以隔离代码中的问题。在我的测试中，这在我的系统上效果很好。

' You can run all your tests here in
' isolation.
Private Sub TestUpdateProgressStatusBar()
    Const start As Long = 1
    Const total As Long = 45
    
    ' Adding Screen Updating to see if it
    ' effects anything.
    Application.ScreenUpdating = False
    
    Dim currentNum As Long
    For currentNum = start To total
        UpdateProgressStatusBar currentNum, total, 45
        Sleep 20
    Next
    
    Application.ScreenUpdating = True
End Sub

【讨论】：