用户窗体内的进度条

Posted 2023-02-19

【中文标题】用户窗体内的进度条

【英文标题】：Progressbar inside userform

【发布时间】：2019-01-20 03:27:23

【问题描述】：

我正在尝试在用户窗体中创建一个进度条，而不是使用单独的进度条，因为如果它位于顶部或背景中，这似乎是不可靠的。所以进度条工作正常，但是它会使整个用户窗体为进度条所做的每次更新而重新绘制。是否可以只刷新进度条而不是整个用户窗体？

我当前的代码看起来像这样：

Public Sub progress(pctCompl As Single)
    Me.Text.caption = Format(pctCompl, "##") & "% Completed"
    Me.Bar.width = Round(pctCompl * 10, 5)
    If Me.Bar.width Mod 20 = 0# Then
        Me.Repaint
    End If
    DoEvents
End Sub

【问题讨论】：

Bar是什么类型的控件？

尝试使用DoEvents 而不是Me.Repaint 可能会慢一点，但用户表单不应该闪烁。

为什么进度条不合适？

【参考方案1】：

在对象浏览器中搜索MSForm 库中的Repaint 时，将找到UserForm，但也会找到Frame。因此，如果您想直接使用用户表单上的进度，那么您可以尝试将您的Bar 包装到MSForms.Frame 中，并且当需要重新绘制时，只需为此框架调用它。在这种情况下，剩余的用户窗体及其控件不应受到此影响，只应重新绘制框架。

Me.Frame1.Repaint ' Me is the main user form

---

而不是有一个单独的进度条，因为这似乎是 如果它将在顶部或背景中，则在这方面不可靠。

这可以通过单独的 modal 表单轻松解决，该表单将显示进度。此表单将具有取消按钮，并在显示时引发事件Start，以便调用表单可以开始执行长时间运行的工作，并在用户单击取消按钮以提前取消进程时引发事件Cancel。例如，HTH。

用户窗体进度

Option Explicit

Public Event Start()
Public Event Cancel(ByRef ignore As Boolean)

Private Sub CommandButtonCancel_Click()
    Dim ignoreCance As Boolean
    ignoreCance = False
    RaiseEvent Cancel(ignoreCance)
    If ignoreCance Then
        Exit Sub
    Else
        Unload Me
    End If
End Sub

Private Sub UserForm_Activate()
    Static isActivated As Boolean
    Me.Repaint
    If Not isActivated Then
        ' ensure only once activation
        isActivated = True
        RaiseEvent Start
        Unload Me
    End If
End Sub

Public Sub Update(ByVal newValue As Long)
    ' update progrress bar here
    ' Pseudo code: Me.Progress.Value = newValue etc.
    Me.Repaint
End Sub

用户窗体主

Option Explicit

Private WithEvents progress As UserFormProgress
Private cancelProgresForm As Boolean

Private Sub CommandButtonDoSomethingLongRunning_Click()
    Set progress = New UserFormProgress
    ' Set progress form
    ' progress.Caption = ...
    ' progress.MaxValue = 123456789
    progress.Show vbModal
End Sub

Private Sub progress_Start()
    ' Callback from progress form, here runs the lung running process
    ' calculate some complete status value
    Dim completeValue As Long
    completeValue = 0
    cancelProgresForm = False
    Do
        completeValue = completeValue + 1
        progress.Update completeValue
        DoEvents
    Loop While cancelProgresForm = False And completeValue < progres.MaxValue 
End Sub

Private Sub progress_Cancel(ignore As Boolean)
    If MsgBox("Do you want to cancel?", vbQuestion Or vbYesNo) = vbNo Then
        ignore = True
    Else
        ignore = False
        cancelProgresForm = True
    End If
End Sub