VBA实战技巧30:创建自定义的进度条1

excelperfect

宏是Excel中最好的工具之一,可以让我们节省时间。

使用VBA宏,可以自动执行重复、单调且有时非常无聊的任务。在某些情况下,这有可能将数小时的工作减少到几分钟或几秒钟。

但并非所有宏都可以实现此类性能要求,有时候数据实在太庞大了,电脑只能运行这么快。在极端情况下,任务可能进展得极其缓慢,以致我们认为系统可能已锁定或崩溃。

因此,发明了进度条。

在Windows的早期,机器被认为是缓慢且容易崩溃的。通过向用户提供进度的视觉指示器,我们知道系统仍在工作,并且可以合理猜测任务何时完成。

在宏执行可能需要相当长时间的情况下,为用户提供进度条是一个不错的选择。

本文所介绍的进度条创建过程代码可以用于其他任务中,示例中,我们的自动化过程将遍历表中的记录,在每条记录处暂停1/10秒。

1.设置可视化界面

使用VBA的用户窗体创建进度条。首先,在VBE中,单击“插入——用户窗体”,结果如下图1所示。

图1

重新命名该窗体名称为“UserForm_v1”,标题为“创建PDF文档”,如下图2所示。

图2

在窗体中:

  • 插入一个标签并设置合适的标题;

  • 插入一幅图像;

  • 插入一个框架,用作滚动条的边框并显示数字百分比计数器。将其标题设置为“0%”,这将在代码执行期间更改为读取进度百分比。

  • 在框架内,插入另一个标签,该标签将不包含文本,而是充当滚动条。这是通过为标签内部着色并逐渐调整其大小来执行的,随着宏的执行,它会越来越大。标签的属性可能是:BackColor– &H00C00000& (蓝色),BackStyle –1-fmBackStyleOpaque,BorderColor– &H80000006& (灰色),Height – 30,SpecialEffect –1-fmSpecialEffectRaised,Width –18。

结果如下图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

上述代码中:

  • 表中有“N”行,循环将执行“N”次。

  • PCT = 计算出不断增加的百分比,从1/N开始,以N/N结束(即1%到100%)。表中的记录越多,百分比计算的粒度就越细。

  • 计时器将计数到1/10秒,从而产生非常小的暂停效果,这可以防止进度条在此演示中移动得太快。在实际中,可能希望忽略这种自我限制的“暂停”,因为它会妨碍性能。

  • Call UpdateProgress(Pct)行将计算出的百分比(Pct)传递给UpdateProgress,该百分比将显示在框架的标题中。

完成时从屏幕移除窗体:

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中的值有两个用途:

  • Pct的值显示在框架的标题中

  • Pct用于计算标签对象的Width属性

  • .Repaint指令强制标签对象根据新计算的Width进行可视化刷新

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

(0)

相关推荐