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
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