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