Status Bar Progress Meter not showing messages

问题

I'm trying to put together a 'Status Bar Progress Meter' to help the user when loading a lengthy macro.

I've carried out some research and found this to be the type that I'd like to use.

The problem I have is that the progress bar doesn't move across the Status Bar and the first and last messages i.e. "Working" and "All Files Extracted" are not shown. Where have I gone wrong?

Private Sub btnFetchFiles_Click()

    Dim j As Integer

        iRow = 20
        fPath = "\\c\s\CAF1\Dragon Mentor Group\Dragon Scripts\Current\April 2015"
        If fPath <> "" Then

            ' make StatusBar visible
            Application.DisplayStatusBar = True
            Set FSO = New Scripting.FileSystemObject
            'First Message
            Application.StatusBar = String(5, ChrW(9609)) & " Working..."
            If FSO.FolderExists(fPath) <> False Then
                'Second Message
                Application.StatusBar = String(5, ChrW(9609)) & " Working..."
                Set SourceFolder = FSO.GetFolder(fPath)
                'Third Message
                Application.StatusBar = String(5, ChrW(9609)) & " Working..."
                IsSubFolder = True
                'Fourth Message
                Application.StatusBar = String(5, ChrW(9609)) & " Still Working..."
                Call DeleteRows
                If AllFilesCheckBox.Value = True Then
                'Fifth Message
                Application.StatusBar = String(5, ChrW(9609)) & " Still Working..."
                    Call ListFilesInFolder(SourceFolder, IsSubFolder)
                    Call ResultSorting(xlAscending, "C20")
                    Call FormatCells
                Else
                    Call ListFilesInFolderXtn(SourceFolder, IsSubFolder)
                    Call ResultSorting(xlAscending, "C20")
                    Call FormatCells
                End If
                'Sixth Message
                Application.StatusBar = String(5, ChrW(9609)) & "Still Working..."
                lblFCount.Caption = iRow - 20
                'Seventh Message
                Application.StatusBar = String(5, ChrW(9609)) & "Almost Done..."
            Else
                MsgBox "Selected Path Does Not Exist !!" & vbNewLine & vbNewLine & "Select Correct One and Try Again !!"
            End If
        Else
            MsgBox "Folder Path Can not be Empty !!" & vbNewLine & vbNewLine & ""
        End If
                'Eigth Message
                Application.StatusBar = String(5, ChrW(9609)) & "All Files Extracted..."
       'Relinquish the StatusBar
        Application.StatusBar = False
    End Sub

回答1:

The reason you don't see them is that they are immediately overwritten by the next StatusBar message.

Take this for example:

   'Eigth Message
   Application.StatusBar = String(5, ChrW(9609)) & "All Files Extracted..."
   'After the previous message has displayed for zero seconds, 
   'Relinquish the StatusBar
   Application.StatusBar = False

You're displaying a message and erasing it right away.

Same idea for your first message. The statements that occur in between probably execute in less than a millisecond, so that's how long your first message will show; hence you don't see it. Which, in a way, makes total sense, because there is no need for a progress meter to be displayed if progress is instantaneous.

The example in the link you provide uses Application.Wait statements to force the program to wait while the progress bare is being shown. But that's just for illustration purposes; you would never slow down your actual program on purpose like that.

---

The reason the progress bar isn't getting longer and longer is that you are explicitly telling it to stay the same length:

String(5, ChrW(9609)) 

will always return a progress bar that is five characters long: ▉▉▉▉▉. The example in the link you provide makes it grow from 5 to 10 to 15.

来源：https://stackoverflow.com/questions/29789439/status-bar-progress-meter-not-showing-messages