En un formulario
Private Sub BtnFECHA_Click()
Dim DateNew As Variant
On Error GoTo errorBtnFECHA
DateNew = GetDate(Me![FECHA])
If Me![FECHA] <> DateNew Or IsNull(Me![FECHA]) Then
Me![FECHA] = DateNew
End If
Me![FECHA].SetFocus
errorBtnFECHA:
Exit Sub
End Sub
Esto que sigue los metes en un modulo
Option Compare Database
Option Explicit
Function GetDate(Optional varDate As Variant) As Variant
Dim PasoValor As Boolean
PasoValor = False
If IsMissing(varDate) Then
varDate = Date
Else
If Not IsDate(varDate) Then
varDate = Date
Else
PasoValor = True
End If
End If
DoCmd.OpenForm FormName:="SUBFORM CALENDARIO", WindowMode:=acDialog, OpenArgs:=varDate
If IsLoaded("SUBFORM CALENDARIO") Then
GetDate = Forms("SUBFORM CALENDARIO").Calendar.Value
DoCmd.Close acForm, "SUBFORM CALENDARIO"
Else
If PasoValor Then
GetDate = varDate
Else
GetDate = Null
End If
End If
End Function
Function IsLoaded(ByVal strformName As String) As Integer
Const conObjStateClosed = 0
Const conDesignView = 0
IsLoaded = False
If SysCmd(acSysCmdGetObjectState, acForm, strformName) <> conObjStateClosed Then
If Forms(strformName).CurrentView <> conDesignView Then
IsLoaded = True
End If
End If
End Function
