Date field in Form

V

Vincent

I entered a date field on an existing form (Date()) and
had to re-compile the code. The form now "lags" prior to
displaying the date. Any suggestions to reduce the lag
time?
 
K

Ken Snell [MVP]

Forms display controls, not fields. So I assume you're referring to the
display of the function's results in a control?

How are you setting the value in that control -- default value? code? macro?
combo box or list box Row Source?

How long is "lag"?

How are you implementing the database - on a single PC? over a network?
 
K

Ken Snell [MVP]

That is very unusual behavior for a control source expression using VBA
function.

Try compacting/repairing the database. Also check that you don't have
virus/spyware on the PC.
 
V

Vincent

I have compacted/repair....used different computers. I
even tried changing the "tab controls" to see if there
would be some improvements. There is code behind the
form that pertains to other controls, but not the date.
Any other way to include the current date?
 
V

Vincent

Ken,
Open
Private Sub Form_Open(Cancel As Integer)

Dim ActForm As String, FuncName As String, SectNum As
Double, EMsg As String, iENum As Long
ActForm = Me.Name
FuncName = "Form_Open"
SectNum = 1
On Error GoTo Form_Open_Err

Me!txtsCompanyName = Forms!f_SYSGlobalValues!
txtCurrentsCompanyName
DoCmd.Hourglass True
Load
Private Sub Form_Load()

End Sub
Current
Private Sub Form_Current()

End Sub
 
K

Ken Snell [MVP]

Can you post all the code that is in the form's module? Most of the code in
the Open event procedure appears to have no purpose other than getting the
value of company name from another form, and I don't think that is the
source of the slowness.
 
V

Vincent

Ken,
Thanks for taking the time to check out the code
(following). The date is Text97
'Form f_SysMainMenu
Option Compare Database
Option Explicit

Dim ynFormOpen As Long
Private Function cbfCallButtons(ByVal Button As String)

Dim ActForm As String, FuncName As String, SectNum As
Double, EMsg As String, iENum As Long
ActForm = Me.Name
FuncName = "cbfCallButtons"
SectNum = 1
On Error GoTo cbfCallButtons_Err

Select Case Button
Case "Exit"
DoCmd.Close acForm, Me.Name
Case "Open"
cmdOk_Click
End Select

cbfCallButtons_Exit:
Exit Function

cbfCallButtons_Err:
iENum = Err
EMsg = Error
ret = Add2ErrorLog(iENum, EMsg, FuncName, SectNum,
ActForm)
ret = ErrorMessage(iENum, EMsg, FuncName, SectNum,
ActForm)
Resume Next

End Function

Private Sub cbonSubsystem_AfterUpdate()

Dim ActForm As String, FuncName As String, SectNum As
Double, EMsg As String, iENum As Long
ActForm = Me.Name
FuncName = "cbonSubsystem_AfterUpdate"
SectNum = 1
On Error GoTo cbonSubsystem_AfterUpdate_Err

Me!lbxsMenuItemsDataEntry.Requery
If Me!lbxsMenuItemsDataEntry.ListCount = 0 Then
Me!tcpDataEntry.Visible = False
Else
Me!tcpDataEntry.Visible = True
End If

Me!lbxsMenuItemsInquiry.Requery
If Me!lbxsMenuItemsInquiry.ListCount = 0 Then
Me!tcpInquiry.Visible = False
Else
Me!tcpInquiry.Visible = True
End If

Me!lbxsMenuItemsReports.Requery
If Me!lbxsMenuItemsReports.ListCount = 0 Then
Me!tcpReports.Visible = False
Else
Me!tcpReports.Visible = True
End If

Me!lbxsMenuItemsActions.Requery
If Me!lbxsMenuItemsActions.ListCount = 0 Then
Me!tcpActions.Visible = False
Else
Me!tcpActions.Visible = True
End If

Me!lbxsMenuItemsSystem.Requery
If Me!lbxsMenuItemsSystem.ListCount = 0 Then
Me!tcpSystem.Visible = False
Else
Me!tcpSystem.Visible = True
End If
ynFormOpen = True

cbonSubsystem_AfterUpdate_Exit:
Exit Sub

cbonSubsystem_AfterUpdate_Err:
iENum = Err
EMsg = Error
ret = Add2ErrorLog(iENum, EMsg, FuncName, SectNum,
ActForm)
ret = ErrorMessage(iENum, EMsg, FuncName, SectNum,
ActForm)
Resume Next

End Sub

Private Sub cmdClose_Click()

Dim ActForm As String, FuncName As String, SectNum As
Double, EMsg As String, iENum As Long
ActForm = Me.Name
FuncName = "cmdClose_Click"
SectNum = 1
On Error GoTo cmdClose_Click_Err

DoCmd.Close acForm, Me.Name

cmdClose_Click_Exit:
Exit Sub

cmdClose_Click_Err:
iENum = Err
EMsg = Error
If iENum = 2501 Then Resume Next 'skip cancel close
error
ret = Add2ErrorLog(iENum, EMsg, FuncName, SectNum,
ActForm)
ret = ErrorMessage(iENum, EMsg, FuncName, SectNum,
ActForm)
Resume Next

End Sub

Private Sub cmdOk_Click()

Dim ActForm As String, FuncName As String, EMsg As
String
Dim SectNum As Double, iENum As Long

ActForm = Me.Name
FuncName = "cmdOK_Click"
SectNum = 1
On Error GoTo cmdOK_Click_Err

ynFormOpen = True
Dim TabValue As Integer
Dim sItemType As String, sObject As String, sErrName
As String

TabValue = Me!tcMainMenu.Value
Select Case TabValue
Case 0
If IsNull(Me!lbxsMenuItemsDataEntry) Then Exit
Sub
sItemType = Me!lbxsMenuItemsDataEntry.Column(2)
sObject = Me!lbxsMenuItemsDataEntry.Column(3)
sErrName = Me!lbxsMenuItemsDataEntry.Column(4)
Case 1
If IsNull(Me!lbxsMenuItemsInquiry) Then Exit Sub
sItemType = Me!lbxsMenuItemsInquiry.Column(2)
sObject = Me!lbxsMenuItemsInquiry.Column(3)
sErrName = Me!lbxsMenuItemsInquiry.Column(4)
Case 2
If IsNull(Me!lbxsMenuItemsReports) Then Exit Sub
sItemType = Me!lbxsMenuItemsReports.Column(2)
sObject = Me!lbxsMenuItemsReports.Column(3)
sErrName = Me!lbxsMenuItemsReports.Column(4)
strReportCalled =
Trim$(Me.lbxsMenuItemsReports.Column(1))
Forms.Item("fp_INVDepreciationSetup").Caption =
strReportCalled
Case 3
If IsNull(Me!lbxsMenuItemsActions) Then Exit Sub
sItemType = Me!lbxsMenuItemsActions.Column(2)
sObject = Me!lbxsMenuItemsActions.Column(3)
sErrName = Me!lbxsMenuItemsActions.Column(4)
Case 4
If IsNull(Me!lbxsMenuItemsSystem) Then Exit Sub
sItemType = Me!lbxsMenuItemsSystem.Column(2)
sObject = Me!lbxsMenuItemsSystem.Column(3)
sErrName = Me!lbxsMenuItemsSystem.Column(4)
End Select

ret = ExecuteSelectedMenuItem(sItemType, sObject,
sErrName)
DoCmd.Hourglass False

cmdOK_Click_Exit:
Exit Sub

cmdOK_Click_Err:
iENum = Err
EMsg = Error
ret = Add2ErrorLog(iENum, EMsg, FuncName, SectNum,
ActForm)
'ret = ErrorMessage(iENum, EMsg, FuncName, SectNum,
ActForm)
Resume Next

End Sub

Private Sub Form_Activate()

Dim ActForm As String, FuncName As String, SectNum As
Double, EMsg As String, iENum As Long

ActForm = Me.Name
FuncName = "Form_Activate"
SectNum = 1
On Error GoTo Form_Activate_Err

'njb 4/9/97 sbShowToolbar "MTXMainMenu"
' added 5/28/97 LHN
sbSetToolBars Me.Name 'as it was said that this
gives error as per client
DoCmd.Hourglass True

If ynFormOpen Then
If Not Me!cbxSetupComplete Then
Dim lComp As Long, ynSC As Long
lComp = DFirst
("pkcCompany", "td_SysCompanyProfile")
ynSC = GetCompanyProfile
(lComp, "ynSetupComplete")
If Not ynSC Then
Me!cbxSetupComplete = False
DoCmd.Hourglass False
DoCmd.OpenForm "fp_SysSetup"
DoCmd.Hourglass False
If Me!cbxSetupComplete Then
MsgBox GetSystemMessage("SysEditProfile"),
vbOKOnly, "Setup Complete"
Me!tcMainMenu = 4
Me!cbonSubsystem = 11
cbonSubsystem_AfterUpdate
End If
Exit Sub
Else
Me!cbxSetupComplete = True
End If
End If
End If
DoCmd.Hourglass False

Form_Activate_Exit:
If FisLoaded("fp_APChecksToBeWritten") Then
If Forms!fp_APChecksToBeWritten.Visible Then
DoCmd.SelectObject
acForm, "fp_APChecksToBeWritten"
End If
End If
Exit Sub

Form_Activate_Err:
iENum = Err
EMsg = Error
ret = Add2ErrorLog(iENum, EMsg, FuncName, SectNum,
ActForm)
ret = ErrorMessage(iENum, EMsg, FuncName, SectNum,
ActForm)
Resume Next

End Sub

Private Sub Form_Deactivate()

'njb 4/9/97 sbHideToolbar "MTXMainMenu"

End Sub

Private Sub Form_Open(Cancel As Integer)

Dim ActForm As String, FuncName As String, SectNum As
Double, EMsg As String, iENum As Long
ActForm = Me.Name
FuncName = "Form_Open"
SectNum = 1
On Error GoTo Form_Open_Err

Me!txtsCompanyName = Forms!f_SYSGlobalValues!
txtCurrentsCompanyName
DoCmd.Hourglass True

If IsNull(Me.HelpFile) Or Me.HelpFile = "" Then
Me.HelpFile = GetRegValue(gcHKeyLocalMachine,
gcMTXKeyName, "HelpFile")
If Me.HelpContextId = 0 Then Me.HelpContextId = 1

ReDim FileList(4) As Long
ReDim Flaglist(3) As String
FileList(0) = 0 'File
FileList(1) = 1 'Edit
FileList(2) = 2 'View
FileList(3) = 3 'Tools
FileList(4) = -1 'End of list flag
' Flags in the FlagList D=Disable, E=Enable |=Separator.
' File: New Open Close|Save|PrintSetup Preview Print
List|Send|Exit
' Edit: Undo | Cut Copy Paste Clear
' View: DataEntry Inquiry Reports Actions|Toolbars
' Tools: Spelling|Calendar Clock
Flaglist(0) = "DEE|D|DDDD|E|E"
Flaglist(1) = "E|EEEE"
Flaglist(2) = "EEEE|E"
Flaglist(3) = "E|EE"
ret = EnableDisableMenuAll(FileList(), Flaglist())

DoCmd.Maximize
DoEvents

ynFormOpen = True

Dim lComp As Long, ynSC As Long
lComp = DFirst("pkcCompany", "td_SysCompanyProfile")
ynSC = GetCompanyProfile(lComp, "ynSetupComplete")
If Not ynSC Then
DoCmd.OpenForm "fp_SysSetup"
Me!cbxSetupComplete = False
Exit Sub
Else
Me!cbxSetupComplete = True
End If
cbonSubsystem_AfterUpdate
SendKeys "{Tab}+{Tab}"
DoCmd.Hourglass False

Form_Open_Exit:
Exit Sub

Form_Open_Err:
iENum = Err
EMsg = Error
ret = Add2ErrorLog(iENum, EMsg, FuncName, SectNum,
ActForm)
ret = ErrorMessage(iENum, EMsg, FuncName, SectNum,
ActForm)
Resume Next

End Sub

Private Sub Form_Unload(Cancel As Integer)
If Not CheckForOpenForms() Then
If MsgBox(GetSystemMessage("MsgEndSession"), 65,
GetSystemMessage("MsgExitMTX")) = 2 Then
Cancel = True
Exit Sub
End If
End If

If GetDeveloperStatus() <> 1 Then
DoCmd.Quit acSave
End If
End Sub


Private Sub lbxsMenuItemsActions_DblClick(Cancel As
Integer)
cmdOk_Click
End Sub


Private Sub lbxsMenuItemsDataEntry_DblClick(Cancel As
Integer)
cmdOk_Click
End Sub



Private Sub lbxsMenuItemsInquiry_DblClick(Cancel As
Integer)
cmdOk_Click
End Sub


Private Sub lbxsMenuItemsReports_DblClick(Cancel As
Integer)
cmdOk_Click
End Sub


Private Sub lbxsMenuItemsSystem_DblClick(Cancel As
Integer)
cmdOk_Click
End Sub


Private Sub Exit_Click()
On Error GoTo Err_Exit_Click

DoCmd.Quit

Exit_Exit_Click:
Exit Sub

Err_Exit_Click:
MsgBox Err.Description
Resume Exit_Exit_Click

End Sub

Private Sub tcpReports_DblClick(Cancel As Integer)
strReportCalled = Trim$(Me.lbxsMenuItemsReports.Column
(1))
Forms.Item("fp_INVDepreciationSetup").Caption =
strReportCalled
End Sub
 
K

Ken Snell [MVP]

Whoa -- there is more code in the Open event procedure now than what you'd
posted before.

I think the reason you're seeing the delay is because you're running code in
the Activate event that appears to be requerying combo boxes (which, if they
have lots of records, can take time), you're calling other functions and
subroutines, etc. All of those things will occur before the Date value is
put into the textbox.
 
V

Vincent

Yes, Ken...I know that. The form was opening rather
quickly prior to inserting the date thing and prior to
expanding the form's size (which would have anything to
do with it).
 
K

Ken Snell [MVP]

I've never seen a slowdown when using =Date() as a control source, so I
would be very surprised if it were the source of the problem. I find four
things cause slow "opening" of forms:
-- the form's recordset has lots of records that must be loaded if not
filtered in the OpenForm action;
-- the form has controls (listbox, combobox) that have lots of records
in the row source that must be loaded;
-- the form has lots of controls to "paint";
-- the form is running code that takes time to finish.

Otherwise, as I noted before, it could be a problem on the PC (spyware,
etc.) or the database may need to be "freshened" (decompile the code or
import all objects into a new database).
 
V

Vincent

Thanks for the insight. It does make sense. I'll try
importing to a new database and see if there is an
improvement. Thanks again for the help!
 
Top