VBA实战技巧30：创建自定义的进度条2
excelperfect
有创意的进度条
采用相反的方式来显示进度，将使用标签“缩小”而不是“增长”。诀窍是我们的标签不是进度的指示器。相反，有一个指示进度的静态图像，而标签将充当静态图形隐藏部分的遮罩，如下图5所示。
图5
通过将标签着色为与背景相同的颜色并将标签的位置放置在图像之上，可以在减小标签的大小时显示图像的一部分。当我们“缩小”标签时，它会给我们一种“增长”图像的错觉，如下图6所示。
图6
大多数情况下，本示例的代码与上一示例是相同的，主要区别在于滚动条/遮罩和百分比显示。
百分比显示
添加一个文本框对象（如下图7所示）并更改其标题（Caption）属性，而不是插入框架对象并更改标题属性。
图7
其灰色背景是一个插入的Image对象，它指向一个带有灰色边框的简单图像。
进度条（静态图像）
绿色的“Excel”进度条是一个绿色矩形的静态图像，带有重复四次的Excel图标，如下图8所示。
图8
进度条（“缩小”遮罩）
与第一个示例相比，“缩小”的标签对象在操作上有两个主要区别。
Width属性的计算方法是将Pct乘以218（最大宽度）并从218中减少。例如，如果Pct为0.5，则宽度为109，原218的一半。
将计算标签的左侧而不是将Left属性固定到设置位置。逻辑是从230（标签的最右侧）中减去计算出的Width。例如，如果Pct为0.5，则计算出的Width为 109，则Left属性计算结果为121。
注意：这些结果代表像素数。109代表像素宽度，121表示距用户窗体左边缘121个像素。根据用户窗体大小，可能需要试验这些值，可能需要进行一些实验才能获得完美的外观。
完整的代码如下：
1.标准模块中的代码
Sub GetMyForm_v2()
Load UserForm_v2
With UserForm_v2
.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_v2')
mylabel =Worksheets('ScrollTest_v2').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
EndIf
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_v2
myScrollTest.Select
MsgBox'生成报告已结束.'& vbLf & vbLf & '请从打印机获取你的报告',vbInformation
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub UpdateProgress(Pct)
With UserForm_v2
.Complete.Caption = Format(Pct, '0%') '以数字形式显示给用户的百分比
.LabelProgress.Width = 218 - Pct * 218 ' 缩短遮罩
.LabelProgress.Left = 218 - .LabelProgress.Width + 12 '重新定位遮罩
.Repaint
End With
DoEvents
End Sub
注：本文学习整理自www.xelplus.com，供有兴趣的朋友参考。
欢迎到知识星球：完美Excel社群，进行技术交流和提问，获取更多电子资料。