当你的程序执行时间较长时，使用一个进度条来展示程序执行的状态是非常必要的。

进度条设计

打开VBE，插入一个用户窗体。

1.在属性窗口中，将该用户窗体命名为urfProgress。

2.设置其ShowModal属性为False，这样在该用户窗体处于打开状态时仍能继续运行程序。

3.调整该用户窗体为合适的大小（高110*宽240）。

进行适当设置后，目前表示进度条的用户窗体如下图1所示。

图1

在用户窗体中插入一个标签控件，用于显示指示程序状态的文本。在属性窗口将其命名为lblCaption，调整该标签的大小以便有足够的空间来容纳将要显示的文本，这里设置其Width属性为174，设置其Caption属性为空（即没有文本）。此时，表示进度条的用户窗体如下图2所示。

图2

接下来，在用户窗体中插入一个框架控件。使该框架在水平和垂直方向上大致居于用户窗体中心，并位于前面添加的标签下方，如下图3所示。

图3

设置框架的属性。将其命名为fraProgress，设置其Caption属性为空（即没有文本），修改其SpecialEffect属性为“2-fmSpecialEffectSunken”。此时，表示进度条的用户窗体如下图4所示。

图4

随后，再插入一个标签。该标签中不会显示任何文本，但是随着程序的运行，该标签长度会不断增加来填充刚刚创建的框架。

1.插入一个标签并放置在刚创建的框架里面，调整尺寸使其与框架重合，如下图5所示。

图5

2.将该标签命名为lblProgress。

3.修改其Caption属性为空（即没有文本）。

4.修改其BackColor属性为你想要的颜色。

5.修改其SpecialEffect属性为“1-fmSpecialEffectRaised”。

此时，表示进度条的用户窗体如下图6所示。

图6

编写程序

隐藏标题栏

在VBE中插入一个标准模块，输入下面使用Windows API的代码来隐藏用户窗体的标题栏：

Public Const GWL_STYLE = -16

Public Const WS_CAPTION = &HC00000

#If VBA7 Then

Public Declare PtrSafe Function GetWindowLong _

Lib “user32” Alias “GetWindowLongA” ( _

ByVal hWnd As Long,_

ByVal nIndex As Long) As Long

Public Declare PtrSafe Function SetWindowLong _

Lib “user32” Alias “SetWindowLongA” ( _

ByVal hWnd As Long,_

ByVal nIndex As Long, _

ByVal dwNewLong As Long) As Long

Public Declare PtrSafe Function DrawMenuBar_

Lib “user32” ( _

ByVal hWnd As Long) As Long

Public Declare PtrSafe Function FindWindowA_

Lib “user32” (ByVallpClassName As String, _

ByVal lpWindowName As String) As Long

#Else

Public Declare Function GetWindowLong _

Lib “user32” Alias “GetWindowLongA” ( _

ByVal hWnd As Long, _

ByVal nIndex As Long) As Long

Public Declare Function SetWindowLong _

Lib “user32” Alias “SetWindowLongA” ( _

ByVal hWnd As Long,_

ByVal nIndex As Long, _

ByVal dwNewLong As Long) As Long

Public Declare Function DrawMenuBar _

Lib”user32″ ( _

ByVal hWnd As Long) As Long

Public Declare Function FindWindowA _

Lib”user32″ (ByVal lpClassName As String, _

ByVal lpWindowName As String) As Long

#End If

Sub HideTitleBar(frm As Object)

Dim lngWindow As Long

Dim lFrmHdl As Long

lFrmHdl = FindWindowA(vbNullString,frm.Caption)

lngWindow = GetWindowLong(lFrmHdl,GWL_STYLE)

lngWindow = lngWindow And (Not WS_CAPTION)

Call SetWindowLong(lFrmHdl, GWL_STYLE,lngWindow)

Call DrawMenuBar(lFrmHdl)

End Sub

用户窗体初始化

在用户窗体urfProgress中，添加Initialize事件代码：

Private Sub UserForm_Initialize()

Me.Height = Me.Height – 10

HideTitleBar.HideTitleBar Me

End Sub

显示进度条

本文的示例以遍历工作表所有已使用的行来更新进度条：

Sub DemoProgress()

Dim i As Long

Dim lngLastRow As Long

Dim pct As Single

lngLastRow = Range(“A” &Rows.Count).End(xlUp).Row

‘进度条宽度从0开始

urfProgress.lblProgress.Width = 0

urfProgress.Show

For i = 1 To lngLastRow

pct = i / lngLastRow

‘计算进度条百分比并增加相应宽度

With urfProgress

.lblCaption.Caption = “正在处理” & lngLastRow &”行中的第” & i & “行.”

.lblProgress.Width = pct *(.fraProgress.Width)

End With

DoEvents

‘可以在这里插入真正要执行操作的程序

‘如果进度完成则卸载用户窗体

If i = lngLastRow Then Unload urfProgress

Next i

End Sub

运行程序后的效果如下图7所示。

图7

上面的示例是在程序中刚好也有循环时，在执行循环过程的同时显示进度条。但是，如果没有循环呢？也可以模拟程序执行进度：

Sub DemoProgress2()

‘开始显示进度条

urfProgress.lblProgress.Width = 0

urfProgress.Show

‘模拟完成进度

DoPrecent (0)

‘放置程序代码

‘模拟完成进度

DoPrecent (0.25)

‘放置程序代码

‘模拟完成进度

DoPrecent (0.5)

‘放置程序代码

‘模拟完成进度

DoPrecent (0.75)

‘放置程序代码

‘模拟完成进度

DoPrecent (1)

‘卸载窗体,即关闭进度条

Unload urfProgress

EndSub

Sub DoPrecent(pctdone As Single)

With urfProgress

.lblCaption.Caption = pctdone * 100& “% 完成”

.lblProgress.Width = pctdone *(.fraProgress.Width)

End With

DoEvents

End Sub

如果过程占用大量资源，可能会发现进度条不更新或显示为白色，此时可在End With前面添加代码：

urfProgress.Repaint

强制VBA重新绘制进度条，这样在每次更改用户窗体时都会更新。