excel图表使用VBA创建进度条

Question

如题所述

Answer 1

当你的程序执行时间较长时，使用一个进度条来展示程序执行的状态是非常必要的。
进度条设计
打开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重新绘制进度条，这样在每次更改用户窗体时都会更新。