VBA进度条基于修复持续时间

时间:2014-02-03 20:19:02

标签: excel-vba progress-bar duration vba excel

我如何调整此进度条宏来表示代码的持续时间,知道执行代码的总时间是50秒?我正在使用VBA7。

Sub ShowUserForm()
    UserForm1.Show
End Sub
Sub Main()
    Dim Counter As Integer
    Dim RowMax As Integer, ColMax As Integer
    Dim r As Integer, c As Integer
    Dim PctDone As Single

    Application.ScreenUpdating = False
    ' Initialize variables.
    Counter = 1
    RowMax = 100
    ColMax = 100

    ' Loop through cells.
    For r = 1 To RowMax
        For c = 1 To ColMax
            'Put a random number in a cell
            Cells(r, c) = Int(Rnd * 1000)
            Counter = Counter + 1
        Next c

        ' Update the percentage completed.
        PctDone = Counter / (RowMax * ColMax)

        ' Call subroutine that updates the progress bar.
        UpdateProgressBar PctDone
    Next r
    ' The task is finished, so unload the UserForm.
    Unload UserForm1
End Sub

Sub UpdateProgressBar(PctDone As Single)
    With UserForm1

        ' Update the Caption property of the Frame control.
        .FrameProgress.Caption = Format(PctDone, "0%")

        ' Widen the Label control.
        .LabelProgress.Width = PctDone * _
            (.FrameProgress.Width - 10)
    End With

    ' The DoEvents allows the UserForm to update.
    DoEvents
End Sub

0 个答案:

没有答案