Question

我正在为在Excel状态栏中运行的进度条创建代码。我想用2个矩形替换旧的日期用户形式（虽然有效，但我现在会更快地采用一种不那么突兀的方法）。

问题：我用来表示字符的宽度＆＃34;填写＆＃34;和＆＃34;未填写＆＃34;略有不同，当使用其中的100个时，您可以看到最后的百分比似乎随着进度的增加而向右移动。

以下是一些工作示例代码，用于向您展示我的意思：

Sub TestNewProgBar()
Dim X As Long
For X = 1 To 100000
    Call NewProgressBar("Testing", X, 100000)
Next
End Sub

Sub NewProgressBar(MyMessage As String, CurrentVal As Long, MaxVal As Long)
Dim FilledIn As Long, NotFilledIn As Long
If CurrentVal >= MaxVal Then
    Application.StatusBar = MyMessage & ": Complete"
Else
    FilledIn = Round((CurrentVal / MaxVal) * 100, 0)
    NotFilledIn = (100 - FilledIn)
    Application.StatusBar = MyMessage & ": " & Application.WorksheetFunction.Rept(ChrW(9608), FilledIn) & Application.WorksheetFunction.Rept(ChrW(9620), NotFilledIn) & "| " & FilledIn & "%"
End If
End Sub

运行TestNewProgBar并查看状态栏。

这是一个选择不同Unicode符号的简单案例，还是在我这里无法控制的力量？

Answer 1

有一个从U + 25A0到U + 25FF的Unicode块，称为几何形状。有一些匹配的黑/白形状，可以成功地为您的进度条实现。

在下面的测试代码中，有些配对有效，有些则无效！我个人喜欢上一个例子（配对U + 25AE和U + 25AD）。

Option Explicit

Sub TestNewProgBar()
    Dim lngCounter As Long
    Dim lngMax As Long
    Dim strFilledChar As String
    Dim strNotFilledChar As String

    'iterations
    lngMax = 100000

    'small squares - works
    strFilledChar = ChrW(&H25AA)
    strNotFilledChar = ChrW(&H25AB)
    For lngCounter = 1 To lngMax
        Call NewProgressBar("Small squares", lngCounter, lngMax, strFilledChar, strNotFilledChar)
    Next

    'large squares - doesn't work
    strFilledChar = ChrW(&H25A0)
    strNotFilledChar = ChrW(&H25A1)
    For lngCounter = 1 To lngMax
        Call NewProgressBar("Large squares", lngCounter, lngMax, strFilledChar, strNotFilledChar)
    Next

    'large squares 2 - doesn't work (but opposite effect)
    strFilledChar = ChrW(&H25A3)
    strNotFilledChar = ChrW(&H25A1)
    For lngCounter = 1 To lngMax
        Call NewProgressBar("Large squares 2", lngCounter, lngMax, strFilledChar, strNotFilledChar)
    Next

    'mixed vertical/ horizontal rectangles - works!
    strFilledChar = ChrW(&H25AE)
    strNotFilledChar = ChrW(&H25AD)
    For lngCounter = 1 To lngMax
        Call NewProgressBar("Mixed rectangles", lngCounter, lngMax, strFilledChar, strNotFilledChar)
    Next

End Sub

Sub NewProgressBar(strMyMessage As String, lngCurrentVal As Long, lngMaxVal As Long, strFilledChar As String, strNotFilledChar As String)
    Dim lngFilledIn As Long
    Dim lngNotFilledIn As Long
    Dim strStatus As String

    If lngCurrentVal >= lngMaxVal Then
        Application.StatusBar = strMyMessage & ": Complete"
    Else
        lngFilledIn = Round((lngCurrentVal / lngMaxVal) * 100, 0)
        lngNotFilledIn = (100 - lngFilledIn)
        strStatus = strMyMessage & ": " & _
            String(lngFilledIn, strFilledChar) & _
            String(lngNotFilledIn, strNotFilledChar) & _
            "| " & lngFilledIn & "%"
        Application.StatusBar = strStatus
    End If

End Sub

Answer 2

修改：

跟进我的＆＃39;旁边＆＃39;下面，我做了一些实验，当他/她提供this issue的链接时，共产国际正在做点什么。上述问题与 ScreenUpdating 有关。如果状态栏更改时Screenupdating设置为false，则ChrW（9608）和ChrW（9620）的字符宽度相同。

我不知道为什么，但它可以解决问题。因此，您需要执行以下操作：

Application.Screenupdating = False

'code which changes the status bar

Application.Screenupdating = True

（我之前的评论在下面继续）

我更喜欢这种配对：

strFilledChar = ChrW(&H2588) 'a black rectangle, "Full Block"
strUnfilledChar = ChrW(&H2584) 'an array of sparse dots, "Light Shade"

或者这个：

strFilledChar = ChrW(&H2588) 'a black rectangle, "Full Block"
strUnfilledChar = ChrW(&H2500) 'a horizontal line, "Block Drawings Light Horizontal"

（顺便说一句，我遇到的问题与ChrW（9608）和ChrW（9620）宽度不同的问题中描述的问题相同 - 但仅限于一个我的工作簿。在另一个工作簿中，它们具有相同的宽度，因此进度条显示正确。我不知道为什么。）

状态栏中的进度条，空白和填充的字符不等于宽度

2 个答案: