Progress Bar not working

[vba317]

I have a progress bar that is not updating properly. I am running many queries and I would like the progrees bar to tell and show me how long I have to go. Currently on my progressbar the % calculation works but the statusbar does not update. Also currently I am putting in the values to determnine the width of the progressbar, is there a way to have the system calculate the value for me? I have a couple of queries that takes about 15 minutes. If I lived in an ideal world instead of having the hourglass stick in front of me I would have the processing time be included in the statusbar. I do appreciate any help that can be provided.

Tom
This is code on the form

Private Sub cmdProcess_Click()
Dim strQryName As String
Call acbInitMeter("Queries Running", False)
With DoCmd
.SetWarnings False
strQryName = "000_ClearRVUTable"
 iTime = acbUpdateMeter(2, strQryName)
.OpenQuery ("000_ClearRVUTable")
strQryName = "000_del_ClearRptData"
iTime = acbUpdateMeter(4, strQryName)
.OpenQuery ("000_del_ClearRptData")
strQryName = "005_PostDrProcs"
iTime = acbUpdateMeter(55, strQryName)
.OpenQuery ("005_PostDrProcs")
strQryName = "010_PostRVUs"
iTime = acbUpdateMeter(60, strQryName)
.OpenQuery ("010_PostRVUs")
strQryName = "015_updt_SetCPTDesc"
iTime = acbUpdateMeter(65, strQryName)
.OpenQuery ("015_updt_SetCPTDesc")
strQryName = "020_updt_SetWorkRVU"
iTime = acbUpdateMeter(70, strQryName)
.OpenQuery ("020_updt_SetWorkRVU")
strQryName = "025_updt_CalcTotRVU"
iTime = acbUpdateMeter(85, strQryName)
.OpenQuery ("025_updt_CalcTotRVU")
strQryName = "030_ClearZeroRVU"
iTime = acbUpdateMeter(90, strQryName)
.OpenQuery ("030_ClearZeroRVU")
strQryName = "030_ClearZeroRVU"
iTime = acbUpdateMeter(100, strQryName)
.SetWarnings True
End With
End Sub
Public Property Let InitMeter(strTitle As String)
    Me!recStatus.Width = 0
    Me!lblStatus.Caption = "0% complete"
    Me.Caption = strTitle
    DoCmd.RepaintObject
 End Property
Public Property Let UpdateMeter(intValue As Integer)
    Me!recStatus.Width = CInt(Me!lblStatus.Width * (intValue / 100))
    Me!lblStatus.Caption = Format$(intValue, "##") & "% complete"
    DoCmd.RepaintObject
End Property
[/end]

This code is in the module section

[code]
Option Compare Database
Option Explicit
 Private Const mconMeterForm = "frmMain"
 Private Function IsOpen(strForm As String)
      IsOpen = (SysCmd(acSysCmdGetObjectState, acForm, strForm) > 0)
 End Function
  Public Sub acbInitMeter(strTitle As String, fIncludeCancel As Boolean)
     On Error GoTo HandleErr
     DoCmd.OpenForm mconMeterForm
     Forms(mconMeterForm).InitMeter(fIncludeCancel) = strTitle
ExitHere:
     Exit Sub
HandleErr:
     Select Case Err.Number
     Case Else
         MsgBox "Error#" & Err.Number & ": " & Err.Description, _
          , "acbInitMeter"
     End Select
     If IsOpen(mconMeterForm) Then Call acbCloseMeter
     Resume ExitHere
     Resume
 End Sub
 Public Function acbUpdateMeter(intValue As Integer, strQryName As String) As Boolean
     ' Updates the status meter and returns whether
     ' intValue - percentage value 0-100
     On Error GoTo HandleErr
    Forms(mconMeterForm).UpdateMeter = intValue
ExitHere:
        Exit Function
HandleErr:
        Select Case Err.Number
        Case Else
            MsgBox "Error#" & Err.Number & ": " & Err.Description, _
            , "acbUpdateMeter"
        End Select
        If IsOpen(mconMeterForm) Then Call acbCloseMeter
        Resume ExitHere
   End Function
Public Sub acbCloseMeter()
    On Error GoTo HandleErr
     DoCmd.Close acForm, mconMeterForm
ExitHere:
     Exit Sub
HandleErr:
    Select Case Err.Number
     Case Else
         MsgBox "Error#" & Err.Number & ": " & Err.Description, _
         , "acbCloseMeter"
     End Select
     Resume ExitHere
End Sub

 

[PHV]

I'd replace this:
DoCmd.RepaintObject
with this:
DoEvents
Me.Repaint

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[vba317]

I solved why my meter is not updating. The problem is twips. The way MSAccess uses to measure on forms. So instead of the formula

   Me!recStatus.Width = CInt(Me!lblStatus.Width * (intValue / 100))

I found out that 1440 twips = 1" on my form.
My label is 2" long.
So since I predefined the percentage of how long a query roughly takes I had to multiply the percentage number by 28.8 so my label would move properly.

So I changed my formula to:

Public Property Let UpdateMeter(intValue As Integer)
    Dim iValue As Integer
    Dim iTwip As Integer
   '1440 twip = 1" label is 2" long
    iTwip = 28.8
    iValue = intValue * iTwip
    Me!recStatus.Width = iValue
    Me!lblStatus.Caption = Format$(intValue, "##") & "% complete"
    DoCmd.RepaintObject
End Property

If anyone knows how to incorporate system time instead of my predefined numbers any help is appreciated.

Tom