Help with progress meter

P

Paul3rd

Hello,
I have a form ("ApptDis") that sometimes takes 7-8 seconds to load.
I copied code to create a progress meter as a form ("ProgBar")
It also has a module(basProgBar)
I'm using an event in ("ApptDis") to open ("ProgBar").
The two problems are:
I can't get ("ProgBar") to open in front of ("ApptDis"),
-both forms' properties are set to pop-up-
and I can't get the status bar to run at the same time as ("ApptDis")
is embedding an OLE object. The border of ("ProgBar") is visible in front
of ("ApptDis") until ("ApptDis") has finished loading, then ("ProgBar")
moves behind
("ApptDis") and runs correctly.
I'm enclosing all the code, if someone could point me in the right
direction I'd be very grateful.
Paul
-----------------------------
("ApptDis") event code:
Private Sub Form_Current()

'Hide warning message
DoCmd.SetWarnings False
If IsNull(Me.OLEBound11) Then
DoCmd.OpenForm ("ProgBar")
'Specify Source File.
Me.OLEBound11.SourceDoc = Me.Text16
'Create embedded object.
Me.OLEBound11.Action = acOLECreateEmbed
'Unhide warning message
DoCmd.SetWarnings True

End If
End Sub
-----------------------------
("ProgBar") event code:
Option Compare Database
Option Explicit

Private Sub cmdCancel_Click()
On Error Resume Next
fCancel = True
End Sub

Private Sub Form_Load()
On Error Resume Next
fCancel = False
End Sub

Private Sub Form_Open(Cancel As Integer)
On Error Resume Next
DoCmd.MoveSize 1500, 1500, 4800, 2000
End Sub

Private Sub Form_Timer()
On Error Resume Next

DoCmd.Hourglass True
Me.TimerInterval = 1

Me.Repaint
DoEvents

ProcessApptDis

DoCmd.Hourglass False
DoCmd.Close acForm, Me.Name

End Sub
------------------------------
basProgBar Code:
Option Compare Database
Option Explicit

Public fCancel As Boolean

Sub ProcessApptDis()
On Error GoTo Err_Handler

Dim lngCurrentPosition As Long
Dim intTable As Integer
Dim strMsg As String

DoCmd.Hourglass True
lngCurrentPosition = 0

For lngCurrentPosition = 0 To 10000
intTable = lngCurrentPosition \ 100
strMsg = "Processing table #" & intTable

UpdateProgressMeter strMsg, lngCurrentPosition

DoEvents
lngCurrentPosition = lngCurrentPosition + 1
If fCancel Then Exit For
Next

Exit_Here:
DoCmd.Hourglass False
Exit Sub

Err_Handler:
MsgBox Err.Description
fCancel = False
Resume Exit_Here

End Sub

Private Sub UpdateProgressMeter(ByVal strMsg As String, ByVal lngPosition As
Long)
On Error Resume Next

Dim intPercent As Integer
Const conTotal As Integer = 10000

intPercent = (lngPosition / conTotal) * 100

With Forms!ProgBar
!lblBlue.Caption = "Processing " & intPercent & "% Completed"
!lblTransparent.Caption = "Processing " & intPercent & "% Completed"
!lblBlue.Width = intPercent / 100 * !lblTransparent.Width
!lblTable.Caption = strMsg
.Repaint
End With

DoEvents

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top