Question

我正在尝试实施状态栏进度表＆＃39;我找到here并在我的代码中实现了这一点，如下所示：

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(10, ChrW(9609)) & " Working..."
                Set SourceFolder = FSO.GetFolder(fPath)
                'Third Message
                Application.StatusBar = String(15, ChrW(9609)) & " Working..."
                IsSubFolder = True
                'Fourth Message
                Application.StatusBar = String(15, ChrW(9609)) & " Still Working..."
                Call DeleteRows
                If AllFilesCheckBox.Value = True Then
                'Fifth Message
                Application.StatusBar = String(15, 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(20, ChrW(9609)) & "Still Working..."
                lblFCount.Caption = iRow - 20
                'Seventh Message
                Application.StatusBar = String(25, 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(30, ChrW(9609)) & "All Files Extracted..."
       'Relinquish the StatusBar
        Application.StatusBar = False
    End Sub

您将在下图中看到有一个蓝色进度表从左到右运行，带有小矩形，

但是当我运行我的脚本时，我没有留下小矩形但是有一个连续的白色条，如下所示：

为什么呢？我哪里出错？

Answer 1

如果您愿意，可以用百分比替换该栏。我通常根据程序的过程计算百分比。在您的情况下，您似乎正在为进度分配特定值，这也适用。

要实现，就像在代码中替换此行一样简单：

Application.StatusBar = String(5, ChrW(9609)) & " Working..."

以下内容：

Application.StatusBar = "Working... 16% complete"

（16％，因为您的代码中的5/30）。

如果您想要计算它，您可以执行以下操作：

Application.StatusBar = "Working... " & Round(1 / 6 * 100, 0) & "%"

您可以根据需要用变量替换1和6。

Answer 2

您期望蓝色▉▉▉▉▉在每个矩形符号▉之间有一点微小的间隙。

但是你得到了白色▉▉▉▉▉没有间隙。

“为什么会发生这种情况”的答案如下：它只是一种不同的字体！

显然Excel 2013字体是白色的，使得矩形比Excel 2010字体略宽，这样间隙消失了 - 矩形不是蓝色而是白色。

请注意，这绝不会妨碍进度条的功能。这只是一个美学和品味的问题 - 无论你喜欢蓝色还是白色，gaps or no gaps。

进度表字符未按预期显示

2 个答案: