状态栏进度表不显示消息

我正在尝试组合一个“状态栏进度表”来帮助用户加载冗长的宏。

我进行了一些研究并发现this http://datapigtechnologies.com/blog/index.php/show-a-progress-meter-in-the-status-bar/成为我想要使用的类型。

我遇到的问题是进度条不会在状态栏上移动，并且不显示第一条和最后一条消息，即“正在工作”和“已提取的所有文件”。我哪里出错了？

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

您看不到它们的原因是它们会立即被下一个覆盖StatusBar信息。

以此为例：

   '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

您正在显示一条消息并立即将其删除。

你的第一条消息也有同样的想法。之间发生的语句可能会在不到一毫秒的时间内执行，因此这就是您的第一条消息将显示的时间；因此你看不到它。从某种程度上来说，这是完全有道理的，因为如果进度是瞬时的，则不需要显示进度表。

中的示例您提供的链接 http://datapigtechnologies.com/blog/index.php/show-a-progress-meter-in-the-status-bar/ uses Application.Wait语句强制程序在显示进度时等待。但这仅用于说明目的；你永远不会像那样故意减慢你的实际程序。

进度条没有变得越来越长的原因是您明确告诉它保持相同的长度：

String(5, ChrW(9609)) 

将始终返回五个字符长的进度条：▉▉▉▉▉。中的示例您提供的链接 http://datapigtechnologies.com/blog/index.php/show-a-progress-meter-in-the-status-bar/使其从 5 增长到 10 再到 15。