excel - 用户窗体内的进度条

Question

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

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

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

Answer 1

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

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

instead of having a seperate progressbar, because this seems to be unreliable in the respect if it will be on top or in the background.

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

UserFormProgress

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

UserFormMain

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