调试经验——使用VBA显示进度条 (Display Progress Bar with VBA)

需求:有时候运行VBA进行数据处理的时候,运行时间较长(四五十分钟甚至更长),如果能显示一个进度条的话让人比较安心。

今天在网上看到了网友的解决方案:

'自定义的进度条,在状态栏显示
Function GetProgress(curValue, maxValue)
Dim i As Single, j As Integer, s As String
i = maxValue / 20
j = curValue / i
 
For m = 1 To j
    s = s & "■"
Next m
For n = 1 To 20 - j
    s = s & "□"
Next n
GetProgress = s & FormatNumber(curValue / maxValue * 100, 2) & "%"
End Function

然后,在主程序循环体内调用该函数:

rs.Open sql,  connXls, 1
    Dim p As Integer: p = 0
    Do While Not rs.EOF
        p = p + 1
        '在状态栏显示
        Application.StatusBar = GetProgress(p, rs.RecordCount)
    ……

最后,记得在程序使用以下语句恢复状态栏为系统默认状态,否则,进度条将一直显示在那里。

Application.Statusbar = False

补记:

看到了一种更简单的方式(仅显示数值,百分比),无需模拟进度条。个人感觉这种方式更轻量级一点,简单而实用!

Dim x               As Integer 
Dim MyTimer         As Double 

'Change this loop as needed.
For x = 1 To 50
    ' Do stuff
    Application.StatusBar = "Progress: " & x & " of 50: " & Format(x / 50, "0%")
Next x 

Application.StatusBar = False

参考文章:

https://www.cnblogs.com/gxlxzys/archive/2010/10/16/1852967.html

你可能感兴趣的:(自动化(RPA,Robotic,Process,Automa)