Progressbar inside userform

问题

I am trying make a progress bar inside a userform, 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. So the progressbar is working fine, however it makes the whole userform repaint for every update the progressbar does. Is it possible to just refresh the progressbar instead of the whole userform?

My current code do look like this:

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

回答1:

In object browser when searching for Repaint within MSForm library the UserForm will be found but Frame as well. So if you want to use the progress on the user form directly, then you can try to wrap your Bar into MSForms.Frame and when repaint is required, then just call it for this frame. In this case the remaining user form with its controls should not be influenced of this and only the frame should be repainted.

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.

This could be solved easily with separate modal form which will show the progress. This form will have cancel button and will raise event Start when it is displayed so the calling form can start doing the long running job and event Cancel when user clicked cancel button for cancelling of the precess prematurely. Example, 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

来源：https://stackoverflow.com/questions/51821654/progressbar-inside-userform

标签

vba

excel-vba

word-vba