Private Enum DatoFoco
foco_Nombre = 0
foco_Fecha = 1
foco_Socio = 2
End Enum
Private p_Fecha As Date
Private p_Nombre As String
Private p_NumeroSocio As Long
Private s_Cambio As Boolean
' lo usamos para que el botón aceptar sepa adónde dirigirse
Private s_Foco As DatoFoco
Private Property Get Nombre() As String
Nombre = p_Nombre
End Property
Private Property Let Nombre(ByVal n As String)
If n <> "" Then
' fuerzo formato, por ejemplo mínimo 6 caracteres
If Len(n) > 5 Then
p_Nombre = n
s_Cambio = True
Else
MsgBox "El nombre debe tener mínimo 6 caracteres"
End If
Else
MsgBox "El nombre no puede quedar vacío..."
End If
End Property
Private Property Get NumeroSocio() As Long
NumeroSocio = p_NumeroSocio
End Property
Private Property Let NumeroSocio(ByVal n As Long)
' limito a un valor comprendido entre 900 y 4233
If (n > 899) And (n < 4234) Then
p_NumeroSocio = n
s_Cambio = True
Else ' no se acepta el cambio
MsgBox "el número de socio debe estar entre 900 y 4233."
End If
End Property
Private Property Get Fecha() As Date
Fecha = p_Fecha
End Property
Private Property Let Fecha(ByVal f As Date)
' limito a un valor a partir de hoy (para probar)
If DateDiff("d", Now, f) >= 1 Then
p_Fecha = f
s_Cambio = True
Else ' no se acepta el cambio
MsgBox "La fecha tiene que ser posterior a hoy."
End If
End Property
' asignamos valores iniciales al cargar elformulario
Private Sub Form_Load()
p_Nombre = "Nombre" ' no queda vacío...
With TxtDato
' nos aseguramos que el ancho del textbox lo es tanto como será el datetimepicker ' botón del datetimepicker
.Width = TextWidth(" fechaelegida: domingo 31 de diciembre de 0000 hora: 00:00:00 zzzz")
.Alignment = vbCenter
.Text = p_Nombre
Call DTPicker1.Move(.Left, .Top, .Width, .Height)
End With
With DTPicker1
' 1 día menos que hoy, lo hacemos a propósito para poder elegir una fecha menor y ver como la propiedad no deja cambiarlo...
.MinDate = DateAdd("d", -1, Now)
.MaxDate = "31 diciembre " & Year(Now)
.Format = dtpCustom ' personalizado ' HH formato 24 horas, hh formato 12 horas...
.CustomFormat = "'Fecha elegida: ' dddd dd MMMM yyy ' Hora: 'HH:mmtt" 'cadena personalizada dentro del formato entre comillas simples
' otro ejemplo de formato personalizado... campos de fecha separada por _-_ y hora entre corchetes, mostrando segundos.
'.CustomFormat = "'sólo éste año: ' dd'_-_'mm'_-_'yyy ' ['hh:mm:sstt']'"
End With
Me.Show
p_Fecha = Now
p_NumeroSocio = 1200 ' por ejemplo
s_Foco = foco_Nombre
CambiarVisibles ' oculta el timepicker y muesta el textbox
ComNombre.SetFocus
End Sub
Private Sub ComNombre_Click()
TxtDato.Text = Nombre
s_Foco = foco_Nombre
CambiarVisibles
End Sub
Private Sub ComNumSocio_Click()
TxtDato.Text = NumeroSocio
s_Foco = foco_Socio
CambiarVisibles
End Sub
Private Sub ComFecha_Click()
DTPicker1.Value = p_Fecha
s_Foco = foco_Fecha
CambiarVisibles
End Sub
Private Sub ComAceptar_Click()
Select Case s_Foco
Case DatoFoco.foco_Nombre
Nombre = TxtDato.Text ' valida la entrada del dato
TxtDato.Text = Nombre ' devuelve el valor validado
Case DatoFoco.foco_Socio
NumeroSocio = TxtDato.Text ' valida la entrada del dato
TxtDato.Text = NumeroSocio ' devuelve el valor validado
Case DatoFoco.foco_Fecha
Fecha = DTPicker1.Value ' valida la entrada del dato
DTPicker1.Value = Fecha ' devuelve el valor validado
End Select
End Sub
' cuando elegimos un botón traemos al frente o debajo el timepicker sobre el textbox.... es decir ocultamos el que no se va a utilizar, debajo del otro(los hicimos del mismo tamaño ubicados en la misma posición)
Private Sub CambiarVisibles()
'TxtDato.Visible = (s_Foco <> foco_Fecha)
DTPicker1.ZOrder (1 And (s_Foco <> foco_Fecha)) 'TxtDato.Visible) ' sube a primer plano o lo manda debajo del textbox
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If s_Cambio = True Then
' han cambiado los valores de al menos una propiedad...
' si se usa una base de datos sería indicativo de guardar cambios antes de salir
If MsgBox("Han cambiado datos de algunos campos, desea guardarlos a la base de datos?.", vbInformation + vbYesNo, "Guardar cambios....?") = vbYes Then
' guardar cambios en la base de datos
' .........
Else
MsgBox "Los cambios realizados han sido desestimados..."
End If
End If
End Sub