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

我正在创build一个在Excel状态栏中运行的进度条的代码。 我想用2个矩形replace我过去的用户表单（这样可以工作，但是现在我可以更快一点了）。

问题：我用来表示“Filled In”和“Not Filled”的字符宽度略有不同，当使用其中的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并查看状态栏。

这是否会是一个简单的情况下select一个不同的Unicode符号，或者在这里工作的力量超出我的控制？

Answer 1

从U + 25A0到U + 25FF有一个叫做Geometric Shapes的Unicode块。 在那里有一些匹配的黑色/白色形状的对，将成功地为您的进度条实施工作。

在下面的testing代码中，一些对工作，一些不工作！ 我个人喜欢最后一个例子（配对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

编辑：

为了跟进我下面的“搁置”，我做了一些试验，共产国际在提供了这个问题的链接之前就进行了一些尝试。 上述问题与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）有不同宽度的问题 – 但只在我的一个工作簿中，在另一个工作簿中，它们具有相同的宽度，所以进度酒吧显示正确，我不知道为什么。）