状态栏进度表不显示消息

Question

我正在尝试整理一个 'Status Bar Progress Meter' 来帮助用户加载冗长的宏。

我进行了一些研究，发现 this 是我想要使用的类型。

我遇到的问题是进度条没有在状态栏上移动，并且没有显示第一条和最后一条消息，即 "Working" 和 "All Files Extracted"。我哪里做错了？

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

Answer 1

您看不到它们的原因是它们会立即被下一条 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

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

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

link you provide 中的示例使用 Application.Wait 语句强制程序在显示进度时等待。但这只是为了说明目的；你永远不会故意那样放慢你的实际程序。

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

String(5, ChrW(9609))

将始终 return 一个长度为五个字符的进度条：▉▉▉▉▉。 link you provide 中的示例使其从 5 增长到 10 到 15。

状态栏进度表不显示消息

Status Bar Progress Meter not showing messages

excel

vba

excel-2013