進度欄運行宏

Question

這是我的工作簿中的所有文件工作和執行宏觀包裝 上的所有表如果表是可見的宏。我想顯示一個進度條顯示進度，而宏運行..

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