运行宏观时的进度条

Question

这是一个宏，可用于我的工作簿的所有文件并执行宏 wrap 在所有床单上是否可见。我想显示一个进度栏以显示宏运行时的进度。

Sub execute()
Application.ScreenUpdating = False
Application.Cursor = xlWait
' makes sure that the statusbar is visible
Application.DisplayStatusBar = True
'add your message to status bar
Application.StatusBar = "Formatting Report..."
userform1.show
    Call Delete_EmptySheets
    Dim WS_Count As Integer
    Dim i As Worksheet
 ' Set WS_Count equal to the number of worksheets in the active
 ' workbook.
 WS_Count = ActiveWorkbook.Worksheets.Count
' Begin the loop.
For Each i In Worksheets
If Not i.Visible = xlSheetVeryHidden Then
  i.Select
  Call wrap
End If
Next i
Application.Cursor = xlDefault
' gives control of the statusbar back to the programme
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub

对于同样，我使用了带有标签的用户形式，但它仅在宏执行之前或之后执行

Private Sub UserForm_Activate()
 Call ShowProgressBarWithoutPercentage
End Sub
Sub ShowProgressBarWithoutPercentage()
Dim Percent As Integer
Dim PercentComplete As Single
Dim MaxRow, MaxCol As Integer
Dim iRow, iCol As Integer
MaxRow = 500
MaxCol = 500
Percent = 0
'Initially Set the width of the Label as Zero
UserForm1.Label1.Width = 0
For iRow = 1 To MaxRow
    For iCol = 1 To MaxCol
        Worksheets("Sheet1").Cells(iRow, iCol).Value = iRow * iCol
    Next
    PercentComplete = iRow / MaxRow
    UserForm1.Label1.Width = PercentComplete * UserForm1.Width
Next
Unload UserForm1
End Sub

有人可以显示出宏在后台运行时显示进度栏的方法吗？

Answer 1

问题可能是您的Application.ScreenUpdating = False。您可以定期更新屏幕，但这可能首先将其设置为False的好处。状态栏仍在更新，因此您可以将类似以下内容写入状态栏。

0%  |
10% ||||||

并在宏运行时进行更新。

25%  ||||||||||||||
...
50%  ||||||||||||||||||||||||||||
...
100% ||||||||||||||||||||||||||||||||||||||||||||||||||||||||

这是一个示例：

Sub StatusBarPercent(Percent As Double)
    Dim i As Long
    Dim Status As String
    Percent = Percent * 100
    Status = "Formatting Report...  " & Percent & "% "
    For i = 0 To Percent
        Status = Status & "|"
    Next
    Application.StatusBar = Status
End Sub

Answer 2

这可能已经在其他地方回答了……但是我相信它可以回答OP的问题，而没有任何额外的形式，标签，进度栏控件或干扰任何床单内容。

从我的代码出现2015年的出现，第4天，第1部分---

工作表状态栏将进度显示为条形图，

Sub Test1()
' Advent of Code 2015 Day 4, Part 1
Dim counter As LongLong
Dim aString As String
Dim Status As String
Dim BarMultiplier As Long
Dim BarProgress As Long
Const MaxCounter = 4294967#  '4294967296#
Const BarNoSegments = 30

Debug.Print Now()    ' Prints date and time to Immediate Window
BarMultiplier = MaxCounter / BarNoSegments
For counter = 0 To MaxCounter
  
' This part updates the Excel Status bar every 1000 cycles, otherwise it looks like it hangs (Excel can grey and the circle of waiting appears)
' But do it tooo often it slows the calculation with screen updates
  
    If (counter Mod 1000) = 0 Then
        BarProgress = Int((counter + 1) / BarMultiplier)
        
        Status = ""
        
        'Status = "Counter " & counter & ", Progress " & (Int((counter + 1) / MaxCounter * 100) & "% ") ' Used if you want to see the counters during the run
        
        Status = Status & "[" & String(BarProgress, "-")
        
        Status = Status & String(BarNoSegments - BarProgress, "_") & "]"
         
        Application.StatusBar = Status
        
        DoEvents    ' Allows screen to update
        
    End If
    
    
    ' Code using the variable counter Here!
    
    
    
    Next counter
    Application.StatusBar = "Done " & Now()
   End Sub