當你的程序執行時間較長時，使用一個進度條來展示程序執行的狀態是非常必要的。
進度條設計
打開VBE，插入一個用戶窗體。
1.在屬性窗口中，將該用戶窗體命名為urfProgress。
2.設置其ShowModal屬性為False，這樣在該用戶窗體處于打開狀態時仍能繼續運行程序。
3.調整該用戶窗體為合適的大小（高110*寬240）。
進行適當設置后，目前表示進度條的用戶窗體如下圖1所示。
圖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重新繪制進度條，這樣在每次更改用戶窗體時都會更新。
