excelperfect 宏是Excel中最好的工具之一,可以让我们节省时间。 使用VBA宏,可以自动执行重复、单调且有时非常无聊的任务。在某些情况下,这有可能将数小时的工作减少到几分钟或几秒钟。 但并非所有宏都可以实现此类性能要求,有时候数据实在太庞大了,电脑只能运行这么快。在极端情况下,任务可能进展得极其缓慢,以致我们认为系统可能已锁定或崩溃。 因此,发明了进度条。 在Windows的早期,机器被认为是缓慢且容易崩溃的。通过向用户提供进度的视觉指示器,我们知道系统仍在工作,并且可以合理猜测任务何时完成。 在宏执行可能需要相当长时间的情况下,为用户提供进度条是一个不错的选择。 本文所介绍的进度条创建过程代码可以用于其他任务中,示例中,我们的自动化过程将遍历表中的记录,在每条记录处暂停1/10秒。 1.设置可视化界面 使用VBA的用户窗体创建进度条。首先,在VBE中,单击“插入——用户窗体”,结果如下图1所示。 图1 重新命名该窗体名称为“UserForm_v1”,标题为“创建PDF文档”,如下图2所示。 图2 在窗体中:
结果如下图3所示。 图3 2.编写用户窗体代码 双击用户窗体进入其代码模块,在UserForm_Activate事件中,输入代码。 声明变量如下: Dim startrow As Integer Dim endrow As Integer Dim i As Integer Dim myScrollTest As Object 关闭屏幕更新和警告消息: Application.ScreenUpdating = False Application.DisplayAlerts = False 检查确保表中至少有一条被处理的记录: With myScrollTest '起始位置 startrow= .Range('A1').Row + 1 '结束位置 endrow =.Range('A1').End(xlDown).Row If .Range('A2').Value= '' Then MsgBox '请从第 2 行开始粘贴您的实体代码.' ExitSub End If End With 遍历表中的行: '开始遍历 For i = startrow To endrow Pct = (i - startrow + 1) / (endrow - startrow + 1) Call UpdateProgress(Pct) '这是你的工作簿执行许多需要一些时间的事情的地方 startTime = Timer '捕获当前时间 Do Loop Until Timer - startTime >= 0.1 '1/10 秒后前进 '这是你的工作簿完成重复工作的地方 Next i 上述代码中:
完成时从屏幕移除窗体: Unload UserForm_v1 3.启动用户窗体 插入一个标准模块,输入下面的代码: Load UserForm_v1 With UserForm_v1 .StartUpPosition = 0 .Left =Application.Left + (0.5 * Application.Width) - (0.5 * .Width) .Top =Application.Top + (0.5 * Application.Height) - (0.5 * .Height) .Show End With 为了确保用作进度条的用户窗体显示在屏幕中央,使用一些巧妙的数学计算中心位置。计算完成后,我们显示内存加载的用户窗体。 4.宣告代码完成 可以通过多种方式通知用户代码已完成。这里的代码将显示一个消息框,通知用户从打印机获取他们的报告。 MsgBox '生成报告完成' & vbLf& vbLf _ &'请从打印机取回你的报告',vbInformation 5.清理 重新启用屏幕更新和警告消息。 Application.ScreenUpdating = True Application.DisplayAlerts = True 6.使滚动条“拉伸” 上面的代码调用了另一个名为“UpdateProgress”的宏,向该宏传递了一个存储在名为 Pct的变量中的值。 Call UpdateProgress(Pct) 变量Pct中的值有两个用途:
With UserForm_v1 .FrameProgress.Caption = Format(Pct, '0%') .LabelProgress.Width = Pct * (.FrameProgress.Width - 10) .Repaint End With 通过以越来越宽地重新绘制标签对象,实现了标签对象正在增长的错觉。巧妙! “DoEvents”指令允许VBA通过键盘检测用户交互,这在用户可能希望早点退出长时间循环的宏很有用。 7.将宏指定给按钮 添加一个Excel图标图像并将宏指定给该图像,这是通过右键单击图像并选择“指定宏”来实现的。 8.测试进度条 结果如下图4所示。 图4 完整的代码如下: 1.标准模块中的代码 Sub GetMyForm_v1() Load UserForm_v1 With UserForm_v1 .StartUpPosition= 0 .Left= Application.Left + (0.5 * Application.Width) - (0.5 * .Width) .Top= Application.Top + (0.5 * Application.Height) - (0.5 * .Height) .Show End With End Sub 2.用户窗体模块中的代码 Private Sub UserForm_Activate() Dim startrow As Integer Dim endrow As Integer Dim i As Integer Dim myScrollTest As Object Set mainbook = ThisWorkbook Application.ScreenUpdating = False Application.DisplayAlerts = False Set myScrollTest = Worksheets('ScrollTest_v1') mylabel =Worksheets('ScrollTest_v1').Range('A2').Value With myScrollTest '起始位置 startrow = .Range('A1').Row + 1 '结束位置 endrow = .Range('A1').End(xlDown).Row If .Range('A2').Value = '' Then MsgBox '请从第 2 行开始粘贴您的实体代码.' Exit Sub End If End With '开始遍历 For i =startrow To endrow Pct =(i - startrow + 1) / (endrow - startrow + 1) Call UpdateProgress(Pct) '这是你的工作簿执行许多需要一些时间的事情的地方 startTime = Timer '捕获当前时间 Do Loop Until Timer - startTime >= 0.1 '1/10 秒后前进 '这是你的工作簿完成重复工作的地方 Next i Unload UserForm_v1 myScrollTest.Select MsgBox'生成报告完成'& vbLf & vbLf _ &'请从打印机取回你的报告',vbInformation Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub Sub UpdateProgress(Pct) With UserForm_v1 .FrameProgress.Caption = Format(Pct, '0%') .LabelProgress.Width = Pct * (.FrameProgress.Width - 10) .Repaint End With DoEvents End Sub |
|
来自: hercules028 > 《VBA》