T
Tirelle
I am working on an appliation where I use a progress bar to indicate approx.
time until an operation is complete. I will post the code below. My concern
is that is seems that when I run the code... noting else is happening so the
operation that it is supposed to filling in time for is not happening until
progress bar is complete. The progress bar is an activeXcontrol. Here is
the code... i use it by calling the function at the beginnig of a timely
process and if the process finsihes first, I just close form otherwise it
closes when done. based on the complexity of the task and the amount of
times it exceutes, I vary the # of iterations. I am sure there are cleaner
ways to do this but I wanted a more true indication of how long process will
last. Is it true that my code is not running when progress bar is? How do I
fix?
Public Const ProgressBarFormName As String = "frmProgressBar"
Private mintNumSteps As Integer
Dim fInLoop As Boolean
Dim fExitLoop As Boolean
Public Function ShowProgress(ApproxTime As Integer, Optional StatusOf As
String, Optional BarCaption As String, Optional AutoProgress As Boolean)
On Error GoTo Proc_Err
Const AutoIterations = 2000 'Default Iterations
Dim inti As Integer
Dim dblPct As Double
Dim pgbar As ProgressBar
'If Not IsNull(IterationSum) Then ApproxTime = IterationSum
If AutoProgress Then ApproxTime = AutoIterations
DoCmd.OpenForm ProgressBarFormName
Forms!frmProgressbar!txtI = "0%"
'If Not IsNull(StatusOf) Then
' Forms!frmProgressbar.Caption = BarCaption
'End If
If Len(BarCaption & "") > 0 Then
Forms!frmProgressbar.Caption = BarCaption
End If
If Len(StatusOf & "") > 0 Then
Forms!frmProgressbar!txtProgressOf = StatusOf
End If
'If Not IsNull(StatusOf) Then
' Forms!frmProgressbar!txtProgressOf = StatusOf
'End If
Set pgbar = Forms!frmProgressbar!PercentComplete.Object
fInLoop = True
fExitLoop = False
pgbar.Max = ApproxTime
'pgbar.Scrolling = ccScrollingSmooth
pgbar.Scrolling = ccScrollingStandard
'pgbar.Appearance = ccFlat
pgbar.Appearance = cc3D
pgbar.Min = 0
pgbar = 0
Do Until inti > ApproxTime Or fExitLoop
DoEvents
pgbar.Value = inti
Forms!frmProgressbar!txtI = Int((inti / ApproxTime) * 100) & "%"
inti = inti + 1
Loop
fInLoop = False
DoCmd.Close acForm, ProgressBarFormName
Proc_Exit:
Exit Function
Proc_Err:
Select Case Err.Number
Case 2450
Exit Function
Case Else
Select Case ErrorDisplay(Err.Number, Error$,
ProgressBarFormName, "ShowProgress", Erl())
Case errContinue
Resume Next
Case errexit
Resume Proc_Exit
End Select
End Select
End Function
time until an operation is complete. I will post the code below. My concern
is that is seems that when I run the code... noting else is happening so the
operation that it is supposed to filling in time for is not happening until
progress bar is complete. The progress bar is an activeXcontrol. Here is
the code... i use it by calling the function at the beginnig of a timely
process and if the process finsihes first, I just close form otherwise it
closes when done. based on the complexity of the task and the amount of
times it exceutes, I vary the # of iterations. I am sure there are cleaner
ways to do this but I wanted a more true indication of how long process will
last. Is it true that my code is not running when progress bar is? How do I
fix?
Public Const ProgressBarFormName As String = "frmProgressBar"
Private mintNumSteps As Integer
Dim fInLoop As Boolean
Dim fExitLoop As Boolean
Public Function ShowProgress(ApproxTime As Integer, Optional StatusOf As
String, Optional BarCaption As String, Optional AutoProgress As Boolean)
On Error GoTo Proc_Err
Const AutoIterations = 2000 'Default Iterations
Dim inti As Integer
Dim dblPct As Double
Dim pgbar As ProgressBar
'If Not IsNull(IterationSum) Then ApproxTime = IterationSum
If AutoProgress Then ApproxTime = AutoIterations
DoCmd.OpenForm ProgressBarFormName
Forms!frmProgressbar!txtI = "0%"
'If Not IsNull(StatusOf) Then
' Forms!frmProgressbar.Caption = BarCaption
'End If
If Len(BarCaption & "") > 0 Then
Forms!frmProgressbar.Caption = BarCaption
End If
If Len(StatusOf & "") > 0 Then
Forms!frmProgressbar!txtProgressOf = StatusOf
End If
'If Not IsNull(StatusOf) Then
' Forms!frmProgressbar!txtProgressOf = StatusOf
'End If
Set pgbar = Forms!frmProgressbar!PercentComplete.Object
fInLoop = True
fExitLoop = False
pgbar.Max = ApproxTime
'pgbar.Scrolling = ccScrollingSmooth
pgbar.Scrolling = ccScrollingStandard
'pgbar.Appearance = ccFlat
pgbar.Appearance = cc3D
pgbar.Min = 0
pgbar = 0
Do Until inti > ApproxTime Or fExitLoop
DoEvents
pgbar.Value = inti
Forms!frmProgressbar!txtI = Int((inti / ApproxTime) * 100) & "%"
inti = inti + 1
Loop
fInLoop = False
DoCmd.Close acForm, ProgressBarFormName
Proc_Exit:
Exit Function
Proc_Err:
Select Case Err.Number
Case 2450
Exit Function
Case Else
Select Case ErrorDisplay(Err.Number, Error$,
ProgressBarFormName, "ShowProgress", Erl())
Case errContinue
Resume Next
Case errexit
Resume Proc_Exit
End Select
End Select
End Function