agregué a la tabla "Bitacora_Lavado" los campos (H0, H1, H2 ... H24) y en el formulario utilicé las funciones del ejemplo. pero no funciona con los campos, solamente funciona con campos independientes, me podrían decir porque?
Este es el código de mi formulario.
Option Compare Database
Private Sub cerrar_Click()
DoCmd.Quit
End Sub
Private Sub Form_Close()
Me.TimerInterval = 0
End Sub
Private Sub Form_Current()
xHoras
Me.TimerInterval = 1000
End Sub
Private Sub Form_Load()
Segundos
Minutos
Horas
Me.TimerInterval = 1000
End Sub
Private Sub Form_Timer()
Me.xReloj.Value = Format(Time, "HH:mm:ss AM/PM")
If Second(Time) = 0 Then
Call Limpia("s")
Minutos
End If
If Minute(Time) = 0 Then
Call Limpia("m")
Horas
End If
If Hour(Time) = 0 Then
Call Limpia("h")
End If
Segundos
Me.Caption = Time()
End Sub
Private Sub ST_Lavado_Click()
If ST_Lavado.OldValue = "Ocupada" Then
Hora_Fin = Time()
ST_Lavado = "Disponible"
Else
ST_Lavado = ST_Lavado.OldValue
End If
Recalc
End Sub
Private Sub xKilos_AfterUpdate()
Dim xCliente As String
Dim xInicio As Date
Dim xDuracion As Double
Dim xMinuto As Long
Dim xHora As Long
Dim HoraFin As Date
Set db = DBEngine(0)(0)
xCliente = xPlanta.Column(1)
xInicio = Now()
xDuracion = DLookup("Duracion", "Procedimiento", "Procedimiento=" & xProcedimiento)
xHora = Hora_Proceso(xDuracion)
xMinuto = Minutos_Proceso(xDuracion)
HoraFin = Agrega_Tiempo(xInicio, xHora, xMinuto)
xInicio = Format(xInicio, "hh:nn:ss")
strSQL = "INSERT INTO Bitacora_Lavado Values("
strSQL = strSQL & xLavadora & ",'" 'Maquina
strSQL = strSQL & Date & "','" 'Fecha_Lavado
strSQL = strSQL & xInicio & "','" 'Hora_Inicio
strSQL = strSQL & xCliente & "','" 'Cliente
strSQL = strSQL & xPlanta.Column(0) & "'," 'Planta
strSQL = strSQL & 0 & "," 'Ruta
strSQL = strSQL & 0 & ",'" 'Pedido
strSQL = strSQL & "" & "'," 'Tipo_Proceso
strSQL = strSQL & xProcedimiento & "," 'Procedimiento
strSQL = strSQL & xDuracion & "," 'Tiempo de Proceso
strSQL = strSQL & xKilos & ",'" 'Peso_Lavado
strSQL = strSQL & HoraFin & "','" 'Hora_Fin
strSQL = strSQL & Usr & "','" 'Operador
strSQL = strSQL & "Ocupada" & "','" 'St_Lavado
strSQL = strSQL & "" & "','" 'Hora 0
strSQL = strSQL & "" & "','" 'Hora 1
strSQL = strSQL & "" & "','" 'Hora 2
strSQL = strSQL & "" & "','" 'Hora 3
strSQL = strSQL & "" & "','" 'Hora 4
strSQL = strSQL & "" & "','" 'Hora 5
strSQL = strSQL & "" & "','" 'Hora 6
strSQL = strSQL & "" & "','" 'Hora 7
strSQL = strSQL & "" & "','" 'Hora 8
strSQL = strSQL & "" & "','" 'Hora 9
strSQL = strSQL & "" & "','" 'Hora 10
strSQL = strSQL & "" & "','" 'Hora 11
strSQL = strSQL & "" & "','" 'Hora 12
strSQL = strSQL & "" & "','" 'Hora 13
strSQL = strSQL & "" & "','" 'Hora 14
strSQL = strSQL & "" & "','" 'Hora 15
strSQL = strSQL & "" & "','" 'Hora 16
strSQL = strSQL & "" & "','" 'Hora 17
strSQL = strSQL & "" & "','" 'Hora 18
strSQL = strSQL & "" & "','" 'Hora 19
strSQL = strSQL & "" & "','" 'Hora 20
strSQL = strSQL & "" & "','" 'Hora 21
strSQL = strSQL & "" & "','" 'Hora 22
strSQL = strSQL & "" & "','" 'Hora 23
strSQL = strSQL & "" & "')" 'Hora 24
db.Execute (strSQL)
xPlanta = Null
xLavadora = Null
xProcedimiento = Null
xKilos = 0
xTerminar = Null
Recalc
End Sub
Private Sub xProcedimiento_GotFocus()
xProcedimiento.Dropdown
End Sub
Private Sub xTerminar_AfterUpdate()
Set db = DBEngine(0)(0)
strSQL = "UPDATE Bitacora_Lavado set Hora_Fin = '" & Time & "', St_Lavado='Disponible'"
strSQL = strSQL & " WHERE Maquina=" & xTerminar & " And St_Lavado='Ocupada'"
db.Execute (strSQL)
Requery
End Sub
Private Sub xTerminar_GotFocus()
xTerminar.Dropdown
End Sub
Private Sub xHoras()
Dim ctrControl As Control
Dim ctrForm As Form
Dim NombreControl As String
Dim Contador As Integer
Contador = 0
Set ctrForm = Me
For Each ctrControl In ctrForm
With ctrControl
NombreControl = "h0" & Contador
If .Name = NombreControl Then '
If Contador < Hour(Time) Then Contador = Contador + 1
.BackColor = 8388608
.ForeColor = 8388608
End If
End With
Next ctrControl
End Sub
Private Sub Horas()
Dim ctrControl As Control
Dim ctrForm As Form
Dim NombreControl As String
Dim Contador As Integer
Contador = 0
Set ctrForm = Me
For Each ctrControl In ctrForm
With ctrControl
NombreControl = "h" & Contador
If .Name = NombreControl Then '
If Contador < Hour(Time) Then Contador = Contador + 1
.BackColor = 8388608
.ForeColor = 8388608
End If
End With
Next ctrControl
End Sub
Private Sub Minutos()
Dim ctrControl As Control
Dim ctrForm As Form
Dim NombreControl As String
Dim Contador As Integer
Contador = 0
Set ctrForm = Me
For Each ctrControl In ctrForm
NombreControl = "m" & Contador
With ctrControl
If .Name = NombreControl Then '
If Contador < Minute(Time) Then Contador = Contador + 1
.BackColor = 32768
.ForeColor = 32768
End If
End With
Next ctrControl
End Sub
Private Sub Segundos()
Dim ctrControl As Control
Dim ctrForm As Form
Dim NombreControl As String
Dim Contador As Integer
Contador = 0
Set ctrForm = Me
For Each ctrControl In ctrForm
NombreControl = "s" & Contador
With ctrControl
If .Name = NombreControl Then
If Contador < Second(Time) Then Contador = Contador + 1
.BackColor = 255
.ForeColor = 255
End If
End With
Next ctrControl
End Sub
Private Function Limpia(NombreControl As String)
Dim ctrControl As Control
Dim ctrForm As Form
Dim Control As String
Dim Contador As Integer
Control = NombreControl
Set ctrForm = Me
Contador = 1
For Each ctrControl In ctrForm
NombreControl = Control & Contador
With ctrControl
If .Name = NombreControl Then '
Contador = Contador + 1
.BackColor = 16777215
.ForeColor = 16777215
End If
End With
Next ctrControl
End Function