我的子例程运行时如何显示进度条？

Question

我正在尝试找出如何获取进度条以显示下面子例程的进度。有没有人有任何想法如何让这个球滚动？

感谢任何帮助或建议。

Private Sub CommandButton8_Click()

Dim StartTime As Double
Dim MinutesElapsed As String

'Remember time when macro starts
StartTime = Timer

'*****************************

'Direct Data
Sheet4.Activate
Call Test1
Call Test2
Call Test3
Call Test4
'Return to Welcome Page
Sheet8.Activate
'*****************************

'Determine how many seconds the code took to run
 MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")

'Notify user in seconds
 MsgBox "This code ran successfully in " & MinutesElapsed & " minutes", 
vbInformation


End Sub

Answer 1

这是我用于进度条的内容：

Application.StatusBar = "Processing... " & CInt(nRow / nLastRow * 100) & "% " & String(CInt(nRow / nLastRow * 100), ChrW(9609)) 
DoEvents ' optional

nRow是增量编号

nLastRow是100％完成的值

循环完成后，将其重置为：

Application.StatusBar = ""

Answer 2

进度条背后的逻辑是：

使用带有示例照片图像的标签（或图像或按钮）的用户表单。把它放在一个框架中。框架的宽度初始化为零，并随着您的数字增长而增长，方法是在用户窗体内调用Public Sub，直接Userform1.Frame1.width=Percent*MaxWidth/100。 有时您会想要添加doevents，我只使用每个X周期（例如if clng(percent) mod X = 0 then doevents）。

Answer 3

第1步：设计进度对话框。对于以下示例，它必须具有名称frmProgress并且具有两个文本标签lblMsg1和lblMsg2

步骤2：在对话框的代码模块中插入以下代码：

Sub ShowProgressBox()
    Me.Show vbModeless
End Sub

Sub SetProgressMsg(msg1, msg2)
    If (msg1 <> "") Then Me.lblMsg1 = msg1
    If (msg2 <> "") Then Me.lblMsg2 = msg2
    DoEvents
End Sub

Sub SetProgressTitle(title)
    Me.Caption = title
    DoEvents
End Sub

Sub EndProgressBox()
    Unload Me
End Sub

您可以从代码中调用这些函数来显示进度消息。

步骤3：在您的代码中，在冗长的操作开始时，调用

frmProgress.ShowProgressBox

步骤4：在漫长的操作过程中，定期调用set函数显示用户信息，例如循环：

    frmProgress.SetProgressMsg "Searching in "+ myArray(i), "Working..."

步骤5：完成后，关闭进度框：

    frmProgress.EndProgressBox