VBA制作进度条的方法

VBA制作进度条的方法

引用

CSDN

1.

https://blog.csdn.net/weixin_42109443/article/details/137093936

目录

1. 设置进度条的优势
2. VBA设计进度条的方法
   2.1 窗体设计部分
   2.2 代码设计部分
   2.2.1 代码
   2.2.2 代码关键部分讲解

1. 设置进度条的优势

图1-1 优美的进度条示例

如图1-1，为自己的程序设计一个优美的进度条，不光只有视觉上的美感，还是有非常多的好处的。 进度条的好处主要体现在以下几个方面：

(1) 提供实时反馈：进度条可以实时显示任务的完成情况，用户无需猜测或等待，能够直观地了解任务进度。这种实时反馈有助于减少用户的不确定性和焦虑感，提升用户体验。

(2) 预期管理：通过进度条，用户可以预测任务完成所需的时间。这有助于用户更好地规划自己的时间和活动，避免因等待时间过长而产生不满或焦虑。

(3) 增加互动性：进度条为用户提供了一个直观的界面元素，使任务执行过程更加生动和有趣。用户可以通过观察进度条的变化来感知任务的进展，增加了与应用程序或系统的互动性。

(4) 提升效率：当用户在执行长时间任务时，进度条可以让他们了解任务的大致完成时间，从而更高效地安排其他工作或活动。此外，一些进度条还会显示速度信息，这有助于用户调整操作以优化任务完成的速度。

(5) 增强信任感：进度条的存在可以让用户感觉到应用程序或系统在正常运行，并且是在处理他们的请求。这种信任感有助于增强用户对应用程序或系统的信心，提升整体的用户满意度。

综上所述，进度条在提升用户体验、增强互动性、提高效率以及增强用户信任感等方面都具有显著的好处。因此，在设计应用程序或系统时，合理地使用进度条可以有效地提升用户的满意度和体验。

2. VBA设计进度条的方法

VBA是常用的数据处理的工具，有的时候处理数据几十上百万行，Excel像卡死一样，用户如果点击会出现未响应，点多了可能就卡死了。这个时候制作一个进度条是非常有必要的。制作进度条有下面3个好处：

1. 让用户实时了解当前的数据处理进度
2. 减少软件卡死的风险
3. 显得高端^-^

虽然VBA设计出如图1-1类似的进度条有一定难度，但也是可以很轻易的设计一些常见的进度条样式的。那么分享一下我平常使用VBA制作进度条的方法，我常用的有2种样式：

图2-1. 进度条样式1
图2-2. 进度条样式2

下面介绍方法：

2.1 窗体设计部分

窗体部分的设计如图3所示，相关描述见图3：

图2-3. 窗体部分设计

2.2 代码设计部分

2.2.1 代码

Option Explicit
Option Base 0
Sub ProcessBarStyle()
        '****************************************************************************************
        
        '函数功能：将Sheet1-Sheet3,A列到E列求和放在F列，并用进度条显示进度
        '开发者:村里大明白(@CSDN)
        '日期：2024/3/27        
        '****************************************************************************************
        
        Application.ScreenUpdating = False' 关闭屏幕更新
        
        Dim sht As Worksheet '定义工作表变量
        Dim shtRow As Long '工作表的行数
        Dim ProBar_lengthNow, ProBar_lengthMax As Long '进度条当前值和最大值
        Dim ProBar_lengthGap As Long '进度条变化间隔
        Dim ProBar_lengthTemp As Long '进度条变化临时值
        Dim i As Long '循环变量
        
        '进度条数据初始化
        ProBar_lengthNow = 0
        ProBar_lengthMax = 0
        ProBar_lengthTemp = 0
        
        '求进度条最大值
        For Each sht In ThisWorkbook.Worksheets
                shtRow = sht.UsedRange.Rows.Count '工作表行数
                ProBar_lengthMax = ProBar_lengthMax + (shtRow - 1)  '进度条最大值为所有工作表行数之和，(shtRow - 1)减1是因为第一行是表头
        Next sht
        '进度条变化间隔1%
        ProBar_lengthGap = ProBar_lengthMax * 0.01 '1%更新一次进度条显示
        
        '进度条样式1//
        
        For Each sht In ThisWorkbook.Worksheets
                shtRow = sht.UsedRange.Rows.Count '工作表总行数
                For i = 2 To shtRow Step 1
                        sht.Range("F" & i).Value = Application.WorksheetFunction.Sum(sht.Range("A" & i & ":" & "E" & i)) '求和
                        ProBar_lengthTemp = ProBar_lengthTemp + 1
                        ProBar_lengthNow = ProBar_lengthNow + 1
                        If ProBar_lengthTemp >= ProBar_lengthGap Then '每隔1%更新一次
                                With Form_ProcessBar01
                                        .Show 0 '进度条显示
                                        .Label1.Width = Int(500 * ProBar_lengthNow / ProBar_lengthMax) 'label1宽度增长
                                        .Frame1.Caption = CStr(Round(100 * ProBar_lengthNow / ProBar_lengthMax, 0)) & "%" '百分比显示
                                        .Caption = "正在处理" & sht.Name & "的数据....." '正在处理的内容显示在form的caption
                                        DoEvents '将控制权交还给操作系统，允许操作系统进行界面的更新，没有这句代码，进度条会不更新
                                End With
                                ProBar_lengthTemp = 0 '间隔临时值清零，每变化1%循环一次
                        End If
                Next i
        Next sht
       
        Unload Form_ProcessBar01 '进度条样式1卸载
        
        '/进度条样式2/
        '进度条数据初始化
        ProBar_lengthNow = 0
        ProBar_lengthTemp = 0
        
        For Each sht In ThisWorkbook.Worksheets
                shtRow = sht.UsedRange.Rows.Count
                For i = 2 To shtRow Step 1
                        sht.Range("F" & i).Value = Application.WorksheetFunction.Sum(sht.Range("A" & i & ":" & "E" & i)) '求和
                        ProBar_lengthTemp = ProBar_lengthTemp + 1
                        ProBar_lengthNow = ProBar_lengthNow + 1
                        
                        If ProBar_lengthTemp >= ProBar_lengthGap Then '每隔1%更新一次
                                With Form_ProcessBar02
                                        .Show 0 '进度条显示
                                        .Label1.Width = Int(500 * ProBar_lengthNow / ProBar_lengthMax)
                                        .Label2.Left = .Label1.Width + 1 '百分比显示在label2,通过设置label2左侧的距离保证label2始终在label1右侧
                                        .Label2.Caption = CStr(Round(100 * ProBar_lengthNow / ProBar_lengthMax, 0)) & "%"
                                        .Caption = "正在处理" & sht.Name & "的数据....."
                                        DoEvents
                                End With
                                ProBar_lengthTemp = 0
                        End If
                Next i
        Next sht
        '进度条样式1卸载
        Unload Form_ProcessBar02
        
        MsgBox "测试完成！"
    
    Application.ScreenUpdating = True' 屏幕更新开启
        
End Sub

2.2.2 代码关键部分讲解

代码中注释已经加的很详细了，就不再赘述。下面讲一下DoEvents。

在VBA中DoEvents是一个特殊的语句，用于在长时间运行的程序中暂时将控制权交还给操作系统，允许如用户界面更新等其他操作得以执行。当 VBA 代码在执行一个长时间的任务（如循环处理大量数据）时，如果没有使用DoEvents，Excel 可能会停止响应其他用户输入或停止更新用户界面，因为 VBA 正在全力执行代码。这可能导致用户觉得 Excel 应用程序已经崩溃或无响应。在代码中的适当位置插入DoEvents语句，你可以让 VBA 暂时暂停执行当前的任务，允许操作系统处理其他事件，比如用户界面的更新,这有助于保持应用程序的响应性，并给用户一种程序仍在正常运行的印象。

然而，需要注意的是，过度使用DoEvents 可能会降低代码的执行效率，因为它会中断 VBA 代码的执行。因此我们应该只在确实需要保持应用程序响应性的情况下使用它，并且应该尽量减少其调用的频率。如果要处理的数据几十万行，每执行一次 DoEvents 就调用一次，将严重拖慢程序的处理速度。

因此我们上述程序里有进度条每1%更新一次的设计。设置变量ProBar_lengthGap = ProBar_lengthMax * 0.01，临时变量ProBar_lengthTemp在进度条每更新1%就清零一次，重新循环计数。