** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Access y VBA
  Mensajes nuevos Mensajes nuevos RSS - Citas mañana y tarde
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoCitas mañana y tarde

 Responder Responder
Autor
Mensaje
rokoko Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 16/Febrero/2008
Localización: Pamplona
Estado: Sin conexión
Puntos: 3062
Enlace directo a este mensaje Tema: Citas mañana y tarde
    Enviado: 03/Agosto/2019 a las 22:58
Buenas.
Estaba trasteando por la pagina de Neckkito para aprender algomas sobre acces y me he encontrado con este "sencillo" ejemplo.



Esta programado para dar citas de 8 a 15, yo quisiera que tambien diese citas por ejemplo de 18 a 21, mañana y tardes
Pone que solo hay que añadir otro bucle For Next pero no lo consigo por mas que lo intento, el codigo mas o menos lo entiendo, pero hay me atasco.






Private Sub Hora_Enter()
'Declaramos las variables
Dim db As Database
Dim rst As Recordset
Dim qry As QueryDef
Dim i As Integer, j As Integer, k As Integer
Dim miHora As String
Dim horaLibre As Boolean

'Borramos las horas que pudiera haber en el origen para evitar duplicados
Me.Hora.RowSource = ""
Me.Refresh
'Comprobamos que la fecha no esté vacía
If IsNull(Me.Fecha) Then
    MsgBox "El campo Fecha no puede estar vacío", vbInformation + vbOKOnly, "AVISO"
    Me.Fecha.SetFocus
    Exit Sub
End If
'Abrimos la Consulta CCitas, filtrada en el dia correspondiente, para ver las horas libres
Set db = CurrentDb
Set qry = db.QueryDefs("CCitas")
qry.Parameters("miFecha") = Format(Me.Fecha.Value, "dd/mm/yyyy")
Set rst = qry.OpenRecordset()

'Este ejemplo se basa en un horario laboral de 8 a 15 horas, en el que las citas se dan cada 30 minutos
'Si se necesita que sea de mañana y tarde, sólo habría que añadir otro bucle For...Next
'a continuación de estos dos, dentro del bloque If.
If rst.RecordCount = 0 Then     'Si no hay registros en esa consulta es porque están todas libres
    For i = 8 To 14
    For j = 0 To 30 Step 30
    
        miHora = Format(i, "00") & ":" & Format(j, "00")
        Hora.AddItem miHora     'Rellenamos el combo con todas las opciones
    
    Next j
    Next i
    
Else                            'Si hay registros, es que hay horas no disponibles
    For i = 8 To 14
    For j = 0 To 30 Step 30
    
    
        miHora = Format(i, "00") & ":" & Format(j, "00")
        horaLibre = True        'Por defecto la hora está disponible
        rst.MoveFirst
        Do Until rst.EOF        'Buscamos en las horas de la consulta
            If miHora = Format(rst("Hora").Value, "hh:mm") Then
                horaLibre = False   'Si aparece esa hora, la marcamos como no disponible
            End If
            rst.MoveNext
        Loop
        If horaLibre = True Then Hora.AddItem miHora    'Rellenamos con las disponibles
    
    Next j
    Next i
    
    
    
End If


If Hora.ListCount = 0 Then
    MsgBox "No hay citas disponibles para el día seleccionado", vbInformation + vbOKOnly, "SIN CITAS"
End If
'Cerramos conexiones y liberamos memoria
rst.Close
db.Close
Set rst = Nothing
Set db = Nothing
End Sub

Arriba
jilo Ver desplegable
Colaborador
Colaborador


Unido: 19/Diciembre/2004
Localización: TAFALLA
Estado: Sin conexión
Puntos: 959
Enlace directo a este mensaje Enviado: 04/Agosto/2019 a las 09:18
Hola,
Pues en un principio con añadir el bucle de 18 a 21 se solucionaria, quedaria mas o menos así
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
....
Else                            'Si hay registros, es que hay horas no disponibles
    For i = 8 To 14
      For j = 0 To 30 Step 30
          miHora = Format(i, "00") & ":" & Format(j, "00")
          horaLibre = True        'Por defecto la hora está disponible
          rst.MoveFirst
          Do Until rst.EOF        'Buscamos en las horas de la consulta
              If miHora = Format(rst("Hora").Value, "hh:mm") Then
                  horaLibre = False   'Si aparece esa hora, la marcamos como no disponible
              End If
              rst.MoveNext
          Loop
          If horaLibre = True Then Hora.AddItem miHora    'Rellenamos con las disponibles
       Next j
    Next i

    For i = 18 To 21
      For j = 0 To 30 Step 30
          miHora = Format(i, "00") & ":" & Format(j, "00")
          horaLibre = True        'Por defecto la hora está disponible
          rst.MoveFirst
          Do Until rst.EOF        'Buscamos en las horas de la consulta
              If miHora = Format(rst("Hora").Value, "hh:mm") Then
                  horaLibre = False   'Si aparece esa hora, la marcamos como no disponible
              End If
              rst.MoveNext
          Loop
          If horaLibre = True Then Hora.AddItem miHora    'Rellenamos con las disponibles
       Next j
    Next i
End If
Espero te sirva !!!!!!
Iñaki
Arriba
javier.mil Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 10/Agosto/2005
Localización: España
Estado: Sin conexión
Puntos: 4812
Enlace directo a este mensaje Enviado: 05/Agosto/2019 a las 16:45
Buenas,.....  He modificado ligeramente el código Original ..... El código No esta 100% testeado asi que puede haber algún BUG. De todos modos creo que se podría optimizar mucho el código expuesto cambiando de estrategia,...... pero bueno eso ya es otra historia ......


Private Sub Hora_Enter()
Rem Codigo Original: Neckkito >> https://nksvaccessolutions.com/
Rem Modificaciones: Javier.Mil >> www.accessdemo.info

Rem Configuracion USUARO *********
Const cTimeStartAM As Byte = 8
Const cTimeEndAM As Byte = 15
Const cTimeStartPM As Byte = 18 ' << NUEVO************
Const cTimeEndPM As Byte = 21   ' << NUEVO************
Const cInterval As Byte = 30    ' << NUEVO************
Rem ******************************



    Dim db As DAO.Database      ' << NUEVO************
    Dim rst As DAO.Recordset    ' << NUEVO************
    Dim qry As DAO.QueryDef     ' << NUEVO************
    Dim i As Integer
    Dim j As Integer
    '    Dim k As Integer       ' << QUITADO (SOBRA) ************
    Dim miHora As String
    Dim horaLibre As Boolean



    Me.Hora.RowSource = ""
    Me.Refresh


    If IsNull(Me.Fecha) Then
        MsgBox "El campo Fecha no puede estar vacío", vbInformation + vbOKOnly, "AVISO"
        Me.Fecha.SetFocus
        Exit Sub
    End If


    Set db = CurrentDb
    Set qry = db.QueryDefs("CCitas")
    qry.Parameters("miFecha") = Format(Me.Fecha.Value, "dd/mm/yyyy")
    Set rst = qry.OpenRecordset()


    If rst.RecordCount = 0 Then
        For i = cTimeStartAM To cTimeEndAM
            For j = 0 To cInterval Step cInterval
                miHora = Format(i, "00") & ":" & Format(j, "00")
                Hora.AddItem miHora
            Next j
        Next i
       
        For i = cTimeStartPM To cTimeEndPM  ' << NUEVO************
            For j = 0 To cInterval Step cInterval
                miHora = Format(i, "00") & ":" & Format(j, "00")
                Hora.AddItem miHora
            Next j
        Next i


    Else


        For i = cTimeStartAM To cTimeEndAM
            For j = 0 To cInterval Step cInterval
                miHora = Format(i, "00") & ":" & Format(j, "00")
                horaLibre = True
                rst.MoveFirst
                Do Until rst.EOF
                    If miHora = Format(rst("Hora").Value, "hh:mm") Then
                        horaLibre = False
                        Exit Do     ' << NUEVO ************
                    End If
                    rst.MoveNext
                Loop
                If horaLibre = True Then
                    Hora.AddItem miHora
                End If
                If i = cTimeEndAM Then Exit For    ' << NUEVO ************
            Next j
        Next i


        For i = cTimeStartPM To cTimeEndPM  ' << NUEVO************
            For j = 0 To cInterval Step cInterval
                miHora = Format(i, "00") & ":" & Format(j, "00")
                horaLibre = True
                rst.MoveFirst
                Do Until rst.EOF
                    If miHora = Format(rst("Hora").Value, "hh:mm") Then
                        horaLibre = False
                        Exit Do     ' << NUEVO ************
                    End If
                    rst.MoveNext
                Loop
                If horaLibre = True Then
                    Hora.AddItem miHora
                End If
                If i = cTimeEndPM Then Exit For   ' << NUEVO ************
            Next j
        Next i
    End If


    If Hora.ListCount = 0 Then
        MsgBox "No hay citas disponibles para el día seleccionado", vbInformation + vbOKOnly, "SIN CITAS"
    End If


    rst.Close
    db.Close
    Set rst = Nothing
    Set qry = Nothing       ' << NUEVO ************
    Set db = Nothing
End Sub




 



Editado por javier.mil - 05/Agosto/2019 a las 16:49
Arriba
guarracuco Ver desplegable
Moderador
Moderador


Unido: 24/Abril/2004
Localización: EEUU
Estado: Sin conexión
Puntos: 3239
Enlace directo a este mensaje Enviado: 05/Agosto/2019 a las 22:33
Una tabla llamada horas para almacenar las horas. Otra tabla llamada reservaciones.
Si ejecutamos una consulta como la siguiente, se obtiene las horas disponibles.
La otra ventaja, es que se puede por formulario modifucar las horas.

select `time` from `horas` h left join reservations r on h.time = r.hour where hour is null.

Edito:
Estaba en el trabajo donde no dispongo de tiempo, por eso esa respuesta incompleta.
Esta es otra de muchas maneras de abordar el problema, sin codigo.



Editado por guarracuco - 06/Agosto/2019 a las 03:00
Arriba
fcoval Ver desplegable
Asiduo
Asiduo


Unido: 19/Enero/2013
Estado: Sin conexión
Puntos: 225
Enlace directo a este mensaje Enviado: 06/Agosto/2019 a las 11:19
Por si quieres menos líneas de código...


Private Sub Hora_Enter()


Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim qry As DAO.QueryDef

Dim i As Integer, j As Integer
Dim miHora As String

Me.Hora.RowSource = ""
Me.Refresh

If IsNull(Me.Fecha) Then
    MsgBox "El campo Fecha no puede estar vacío", vbInformation + vbOKOnly, "AVISO"
    Me.Fecha.SetFocus
    Exit Sub
End If

Set db = CurrentDb
Set qry = db.QueryDefs("CCitas")
qry.Parameters("miFecha") = Format(Me.Fecha.Value, "dd/mm/yyyy")
Set rst = qry.OpenRecordset()


Dim HInicio As Byte, HFin As Byte

'-- MAÑANAS --
HInicio = 8
HFin = 15
GoSub Tratar_Horario:

'-- TARDES --
HInicio = 18
HFin = 21
GoSub Tratar_Horario:


If Hora.ListCount = 0 Then
    MsgBox "No hay citas disponibles para el día seleccionado", vbInformation + vbOKOnly, "SIN CITAS"
End If

rst.Close
db.Close
Set rst = Nothing
Set db = Nothing

Exit Sub

Tratar_Horario:
    For i = HInicio To HFin
    For j = 0 To 30 Step 30
    miHora = Format(i, "00") & ":" & Format(j, "00")
    rst.FindFirst "Hora= #" & Format(CVDate(miHora), "hh:mm") & "#"
    If rst.NoMatch Then Hora.AddItem miHora
    Next j
    Next i
Return

End Sub

Arriba
javier.mil Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 10/Agosto/2005
Localización: España
Estado: Sin conexión
Puntos: 4812
Enlace directo a este mensaje Enviado: 06/Agosto/2019 a las 13:12
y Si quieres usar el código de fcoval y que se acabe a la hora exacta y No añada 30 minutos adicionales cambiaría:


Donde pone:
Tratar_Horario:
    For i = HInicio To HFin
           
        For j = 0 To 30 Step 30
            miHora = Format(i, "00") & ":" & Format(j, "00")
            rst.FindFirst "Hora= #" & Format(CVDate(miHora), "hh:mm") & "#"
            If rst.NoMatch Then Hora.AddItem miHora
        Next j
    Next i

Cambiarlo por esto otro

Tratar_Horario:
    For i = HInicio To HFin
           
        For j = 0 To 30 Step 30
            miHora = Format(i, "00") & ":" & Format(j, "00")
            rst.FindFirst "Hora= #" & Format(CVDate(miHora), "hh:mm") & "#"
            If rst.NoMatch Then Hora.AddItem miHora
            If i = HFin Then Exit For   ' << NUEVO ************
        Next j
    Next i

 

Arriba
rokoko Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 16/Febrero/2008
Localización: Pamplona
Estado: Sin conexión
Puntos: 3062
Enlace directo a este mensaje Enviado: 07/Agosto/2019 a las 12:35
Excelente por parte de todos!!!!ClapClapClap

La de guarruco sin codigo "facil", una vez visto claro.

Se puede cerrar

Muchas gracias.
Arriba
rokoko Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 16/Febrero/2008
Localización: Pamplona
Estado: Sin conexión
Puntos: 3062
Enlace directo a este mensaje Enviado: 08/Agosto/2019 a las 22:00
Probando mas a fondo lo de guarruco, no filtraba por fechas, vamos que cuando gastabas las horas de cita no se renovaban para otro dia. No tengo dudas que lo sabes hacer, solo que no lo has desarrolado.Wink

Las consultas quedarian asi. He utilizado dos, quizas con una se pueda, pero no me salia.
Con esto conseguimos que cada dia tenga sus citas. La segunda consulta es de la que se nutre el cuadro combinado HoraReserva.

Esta consulta se llama 00HorasFecha
SELECT tbReservas.Fecha, tbReservas.HoraReserva
FROM tbReservas
WHERE (((tbReservas.Fecha)=[Formularios]![frmReservas3]![Fecha]));


SELECT tbHoras.Horas
FROM 00HorasFecha RIGHT JOIN tbHoras ON [00HorasFecha].HoraReserva = tbHoras.Horas
WHERE ((([00HorasFecha].HoraReserva) Is Null));

tbReservas
-id
-Fecha
-Cliente
-HoraReserva

tbHoras
-Horas

Y formulario llamado frmReservas3, en el evento despues de actualizar de HoraReserva lleva un requery del cuadro combinado, y Me.reflesh. Y en el evento al entrar otro requery.

Private Sub HoraReserva_AfterUpdate()
Me.Refresh
Me.HoraReserva.Requery
End Sub

Private Sub HoraReserva_Enter()
Me.HoraReserva.Requery
End Sub








Arriba
rokoko Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 16/Febrero/2008
Localización: Pamplona
Estado: Sin conexión
Puntos: 3062
Enlace directo a este mensaje Enviado: 10/Agosto/2019 a las 21:33
Se puede cerrar!!!!

Gracias
Arriba
mounir Ver desplegable
Colaborador
Colaborador


Unido: 09/Febrero/2009
Localización: Asturias-España
Estado: Sin conexión
Puntos: 6479
Enlace directo a este mensaje Enviado: 11/Agosto/2019 a las 09:19

Hola!

He simulado lo que te había comentado Carlos (guarracuco) y funciona perfectamente.

Te subo la prueba a ver si no estoy equivocado.

https://www.filebig.net/files/vqbuKxFUdx
Un Saludo.
Arriba
rokoko Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 16/Febrero/2008
Localización: Pamplona
Estado: Sin conexión
Puntos: 3062
Enlace directo a este mensaje Enviado: 11/Agosto/2019 a las 10:10
Si, en la consulta no salen las horas que ya estan en las citas, pero yo me refiero a que si el 05/08/2019 esta la cita de la 8:00 reservada, ya no sale en ningun otro dia  las 8:00  para reservarla, la consulta no trabaja con las fechas.

https://drive.google.com/file/d/1TSDbttNSl_4vJs1mC6oFXdGpt7gEElmX/view?usp=sharing

En este ejemplillo si filtra por fechas. Cada dia tiene sus horas de cita disponibles, si la reservas para un dia x ya no esta disponible para ese mismo dia, pero si lo estara en otro dia diferente.

Saludos


Arriba
mounir Ver desplegable
Colaborador
Colaborador


Unido: 09/Febrero/2009
Localización: Asturias-España
Estado: Sin conexión
Puntos: 6479
Enlace directo a este mensaje Enviado: 11/Agosto/2019 a las 10:27
Hola!

Perfecto, no me di cuenta de este detalle.

Gracias.
Un Saludo.
Arriba
rokoko Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 16/Febrero/2008
Localización: Pamplona
Estado: Sin conexión
Puntos: 3062
Enlace directo a este mensaje Enviado: 15/Agosto/2019 a las 17:40
Se puede cerrar, gracias
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable