excelperfect
宏是Excel中最好的工具之一，可以讓我們節(jié)省時間。
使用VBA宏，可以自動執(zhí)行重復(fù)、單調(diào)且有時非常無聊的任務(wù)。在某些情況下，這有可能將數(shù)小時的工作減少到幾分鐘或幾秒鐘。
但并非所有宏都可以實現(xiàn)此類性能要求，有時候數(shù)據(jù)實在太龐大了，電腦只能運行這么快。在極端情況下，任務(wù)可能進(jìn)展得極其緩慢，以致我們認(rèn)為系統(tǒng)可能已鎖定或崩潰。
因此，發(fā)明了進(jìn)度條。
在Windows的早期，機(jī)器被認(rèn)為是緩慢且容易崩潰的。通過向用戶提供進(jìn)度的視覺指示器，我們知道系統(tǒng)仍在工作，并且可以合理猜測任務(wù)何時完成。
在宏執(zhí)行可能需要相當(dāng)長時間的情況下，為用戶提供進(jìn)度條是一個不錯的選擇。
本文所介紹的進(jìn)度條創(chuàng)建過程代碼可以用于其他任務(wù)中，示例中，我們的自動化過程將遍歷表中的記錄，在每條記錄處暫停1/10秒。
1.設(shè)置可視化界面
使用VBA的用戶窗體創(chuàng)建進(jìn)度條。首先，在VBE中，單擊“插入——用戶窗體”，結(jié)果如下圖1所示。
圖1
重新命名該窗體名稱為“UserForm_v1”，標(biāo)題為“創(chuàng)建PDF文檔”，如下圖2所示。
圖2
在窗體中：
插入一個標(biāo)簽并設(shè)置合適的標(biāo)題；
插入一幅圖像；
插入一個框架，用作滾動條的邊框并顯示數(shù)字百分比計數(shù)器。將其標(biāo)題設(shè)置為“0%”，這將在代碼執(zhí)行期間更改為讀取進(jìn)度百分比。
在框架內(nèi)，插入另一個標(biāo)簽，該標(biāo)簽將不包含文本，而是充當(dāng)滾動條。這是通過為標(biāo)簽內(nèi)部著色并逐漸調(diào)整其大小來執(zhí)行的，隨著宏的執(zhí)行，它會越來越大。標(biāo)簽的屬性可能是：BackColor– &H00C00000& (藍(lán)色)，BackStyle –1-fmBackStyleOpaque，BorderColor– &H80000006& (灰色)，Height – 30，SpecialEffect –1-fmSpecialEffectRaised，Width –18。
結(jié)果如下圖3所示。
圖3
2.編寫用戶窗體代碼
雙擊用戶窗體進(jìn)入其代碼模塊，在UserForm_Activate事件中，輸入代碼。
聲明變量如下：
Dim startrow As Integer
Dim endrow As Integer
Dim i As Integer
Dim myScrollTest As Object
關(guān)閉屏幕更新和警告消息：
Application.ScreenUpdating = False
Application.DisplayAlerts = False
檢查確保表中至少有一條被處理的記錄：
With myScrollTest
'起始位置
startrow= .Range('A1').Row + 1
'結(jié)束位置
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)
'這是你的工作簿執(zhí)行許多需要一些時間的事情的地方
startTime = Timer '捕獲當(dāng)前時間
Do
Loop Until Timer - startTime >= 0.1 '1/10 秒后前進(jìn)
'這是你的工作簿完成重復(fù)工作的地方
Next i
上述代碼中：
表中有“N”行，循環(huán)將執(zhí)行“N”次。
PCT = 計算出不斷增加的百分比，從1/N開始，以N/N結(jié)束（即1%到100%）。表中的記錄越多，百分比計算的粒度就越細(xì)。
計時器將計數(shù)到1/10秒，從而產(chǎn)生非常小的暫停效果，這可以防止進(jìn)度條在此演示中移動得太快。在實際中，可能希望忽略這種自我限制的“暫?！保驗樗鼤恋K性能。
Call UpdateProgress(Pct)行將計算出的百分比(Pct)傳遞給UpdateProgress，該百分比將顯示在框架的標(biāo)題中。
完成時從屏幕移除窗體：
Unload UserForm_v1
3.啟動用戶窗體
插入一個標(biāo)準(zhǔn)模塊，輸入下面的代碼：
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
為了確保用作進(jìn)度條的用戶窗體顯示在屏幕中央，使用一些巧妙的數(shù)學(xué)計算中心位置。計算完成后，我們顯示內(nèi)存加載的用戶窗體。
4.宣告代碼完成
可以通過多種方式通知用戶代碼已完成。這里的代碼將顯示一個消息框，通知用戶從打印機(jī)獲取他們的報告。
MsgBox '生成報告完成' & vbLf& vbLf _
&'請從打印機(jī)取回你的報告',vbInformation
5.清理
重新啟用屏幕更新和警告消息。
Application.ScreenUpdating = True
Application.DisplayAlerts = True
6.使?jié)L動條“拉伸”
上面的代碼調(diào)用了另一個名為“UpdateProgress”的宏，向該宏傳遞了一個存儲在名為 Pct的變量中的值。
Call UpdateProgress(Pct)
變量Pct中的值有兩個用途：
Pct的值顯示在框架的標(biāo)題中
Pct用于計算標(biāo)簽對象的Width屬性
.Repaint指令強(qiáng)制標(biāo)簽對象根據(jù)新計算的Width進(jìn)行可視化刷新
With UserForm_v1
.FrameProgress.Caption = Format(Pct, '0%')
.LabelProgress.Width = Pct * (.FrameProgress.Width - 10)
.Repaint
End With
通過以越來越寬地重新繪制標(biāo)簽對象，實現(xiàn)了標(biāo)簽對象正在增長的錯覺。巧妙！
“DoEvents”指令允許VBA通過鍵盤檢測用戶交互，這在用戶可能希望早點退出長時間循環(huán)的宏很有用。
7.將宏指定給按鈕
添加一個Excel圖標(biāo)圖像并將宏指定給該圖像，這是通過右鍵單擊圖像并選擇“指定宏”來實現(xiàn)的。
8.測試進(jìn)度條
結(jié)果如下圖4所示。
圖4
完整的代碼如下：
1.標(biāo)準(zhǔn)模塊中的代碼
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
'結(jié)束位置
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)
'這是你的工作簿執(zhí)行許多需要一些時間的事情的地方
startTime = Timer '捕獲當(dāng)前時間
Do
Loop Until Timer - startTime >= 0.1 '1/10 秒后前進(jìn)
'這是你的工作簿完成重復(fù)工作的地方
Next i
Unload UserForm_v1
myScrollTest.Select
MsgBox'生成報告完成'& vbLf & vbLf _
&'請從打印機(jī)取回你的報告',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
聯(lián)系客服
