How are KellyJo . . . . .
What you want can be done, its just that [blue]
Defaults can only be permanently saved in Design View![/blue]. You can change the Default and use it during runtime, but it won't be saved, even on closing. Next time you open the form the origional Default is restored.
The provided code first checks that a value for the control exist. [blue]If not, the record is not allowed to be saved until the user makes it so[/blue]. If a value exist, it then compares the value against the [blue]default[/blue] for the control. If the values differ you are prompted wether you want to update the Default. If you answer [purple]'Yes'[/purple] the default is updated, answer [purple]'No'[/purple] and Default update is bypassed and you continue on with normal form navigation.
Special Note: You substitute any names in [purple]
purple![/purple]
So . . . lets do it . . . . .
First, the code requires the [blue]Microsoft DAO 3.6 Object Library[/blue]. Open any code window, then click Tools - References . . . Make sure the library is checked and pushed (up arrow) as high in priority as it will go.
[blue]
This next section is very important[/blue]. [blue]
Application.Echo[/blue] is used to turn screen updating off during the switching back & forth of the form between Normal & Design View. If while echo is off an error occurs in code, it will appear as if you can do nothing at all. To circumvent this and get back on track a macro [blue]HotKey[/blue] is setup. The HotKey is [blue]
Ctrl+E[/blue] . . . . dont forget it! To set it up:
Goto the Macros Window, click [blue]New[/blue], and setup the following:
Code:
[blue]MacroName Action Function Name
--------- --------- -------------
^E Runcode RestoreEcho()
StopMacro[/blue]
Next, in a module in the modules window copy/paste the following code:
Code:
[blue]Public Function RestoreEcho()
Dim Msg As String, Style As Integer, Title As String
Application.Echo True
Msg = "Application Echo Is On!'"
Style = vbInformation + vbOKOnly
Title = "Echo Restored!"
MsgBox Msg, Style, Title
End Function[/blue]
Compile & Save.
At this point check that the hotkey [blue]
Ctrl+E[/blue] works (a confirmation box will appear). Do not go any further until this is so! . . . .
Next, copy/paste the following code to the same module:
Code:
[blue]Public Sub SaveDefault(frmName As String, ctlName As String, _
idName As String)
Dim frm As Form, hldVal As String, hldID, DatType As Long
Dim db As DAO.Database, rst As DAO.Recordset, Criteria As String
Set frm = Forms(frmName)
Set db = CurrentDb()
Application.Echo False 'No screen updates
'Hold data for Default & setting BookMark.
hldVal = frm(ctlName)
hldID = frm(idName)
'Get dataType of control for setting Default syntax proper.
Set rst = frm.RecordsetClone
DatType = rst(ctlName).Type
rst.Close
DoCmd.Close acForm, frmName, acSaveYes 'Close the form
DoCmd.OpenForm frmName, acDesign 'Open form in design view
Forms(frmName).Visible = False 'hide form, aids Echo off
Set frm = Forms(frmName)
'*** Set Default ***
Select Case DatType
Case dbDate, dbTime
frm(ctlName).DefaultValue = "#" & hldVal & "#"
Case Else
frm(ctlName).DefaultValue = hldVal
End Select
DoCmd.Close acForm, frmName, acSaveYes 'Close the form
DoCmd.OpenForm frmName, acNormal 'Open the form
Set frm = Forms(frmName)
Set rst = frm.RecordsetClone
'Set proper syntax for FindFirst
Select Case rst(idName).Type
Case dbText
Criteria = "[" & idName & "] = '" & hldID & "'"
Case dbDate, dbTime
Criteria = "[" & idName & "] = #" & hldID & "#"
Case Else
Criteria = "[" & idName & "] = " & hldID
End Select
rst.FindFirst Criteria
frm.Bookmark = rst.Bookmark 'Goto origional record
frm(ctlName).SetFocus 'goto origional control
Set rst = Nothing
Application.Echo True 'Screep updates allowed
Set db = Nothing
Set frm = Nothing
End Sub[/blue]
Next, in the code window for the form copy/paste the following code:
Code:
[blue]Public Function DataOK(ctlName As String) As Boolean
Dim Msg As String, Style As Integer
Dim Title As String, DL As String
DL = vbNewLine & vbNewLine
If Len(Me(ctlName) & "") = 0 Then
Msg = "There is no entry for '" & ctlName & "!'" & DL & _
"The Database will not let you save " & _
"this record unless a value for " & _
ctlName & " is entered!"
Style = vbCritical + vbOKOnly
Title = "Missing data Error!"
MsgBox Msg, Style, Title
Else
DataOK = True
End If
End Function
Public Sub DoDefault(ctlName As String)
Dim Msg As String, Style As Integer
Dim Title As String, DL As String
DL = vbNewLine & vbNewLine
If Me(ctlName) <> Me(ctlName).DefaultValue Then
Msg = "You are about to change the Default " & _
"Value of '" & ctlName & "'" & DL & _
"Are you sure you want to do this?"
Style = vbInformation + vbYesNo
Title = "Change Default? . . . ."
If MsgBox(Msg, Style, Title) = vbYes Then
Call SaveDefault(Me.Name, ctlName, "[purple][b]PrimaryKeyName[/b][/purple]")
End If
End If
End Sub[/blue]
Now . . . for any control you wish to set the default, in the [blue]BeforeUpdate[/blue] event of the control copy/paste the following:
Code:
[blue] If Not DataOK(Screen.ActiveControl.Name) Then Cancel = True[/blue]
For the same reason above, in the [blue]AfterUpdate[/blue] event of the control copy/paste the following:
Code:
[blue] Call DoDefault(Screen.ActiveControl.Name)[/blue]
Beaware: form referencing in code is setup for Single or MainForm. Subform will not work, but can be made so with slight modification. Currently working on a global secnario for this so any form/subform can have Defaults set.
Thats it! . . . . give it a whirl and let me know . . . .
See Ya! . . . . . .
