Citas mañana y tarde |
Responder |
Autor | |
rokoko
Colaborador Unido: 16/Febrero/2008 Localización: Pamplona Estado: Sin conexión Puntos: 3062 |
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 |
|
jilo
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Colaborador Unido: 19/Diciembre/2004 Localización: TAFALLA Estado: Sin conexión Puntos: 959 |
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 |
|
javier.mil
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Colaborador Unido: 10/Agosto/2005 Localización: España Estado: Sin conexión Puntos: 4812 |
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 ...... 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 |
|
guarracuco
Moderador Unido: 24/Abril/2004 Localización: EEUU Estado: Sin conexión Puntos: 3239 |
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 |
|
fcoval
Asiduo Unido: 19/Enero/2013 Estado: Sin conexión Puntos: 225 |
Enviado: 06/Agosto/2019 a las 11:19 |
Por si quieres menos líneas de código...
|
|
javier.mil
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Colaborador Unido: 10/Agosto/2005 Localización: España Estado: Sin conexión Puntos: 4812 |
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 |
|
rokoko
Colaborador Unido: 16/Febrero/2008 Localización: Pamplona Estado: Sin conexión Puntos: 3062 |
Enviado: 07/Agosto/2019 a las 12:35 |
Excelente por parte de todos!!!!
La de guarruco sin codigo "facil", una vez visto claro. Se puede cerrar Muchas gracias.
|
|
rokoko
Colaborador Unido: 16/Febrero/2008 Localización: Pamplona Estado: Sin conexión Puntos: 3062 |
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. 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 |
|
rokoko
Colaborador Unido: 16/Febrero/2008 Localización: Pamplona Estado: Sin conexión Puntos: 3062 |
Enviado: 10/Agosto/2019 a las 21:33 |
Se puede cerrar!!!! Gracias
|
|
mounir
Colaborador Unido: 09/Febrero/2009 Localización: Asturias-España Estado: Sin conexión Puntos: 6479 |
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.
|
|
rokoko
Colaborador Unido: 16/Febrero/2008 Localización: Pamplona Estado: Sin conexión Puntos: 3062 |
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
|
|
mounir
Colaborador Unido: 09/Febrero/2009 Localización: Asturias-España Estado: Sin conexión Puntos: 6479 |
Enviado: 11/Agosto/2019 a las 10:27 |
Hola!
Perfecto, no me di cuenta de este detalle. Gracias. |
|
Un Saludo.
|
|
rokoko
Colaborador Unido: 16/Febrero/2008 Localización: Pamplona Estado: Sin conexión Puntos: 3062 |
Enviado: 15/Agosto/2019 a las 17:40 |
Se puede cerrar, gracias
|
|
Responder | |
Tweet
|
Ir al foro | Permisos de foro Usted No puede publicar nuevos temas en este foro Usted No puede responder a temas en este foro Usted No puede borrar sus mensajes en este foro Usted No puede editar sus mensajes en este foro Usted No puede crear encuestas en este foro Usted No puede votar en encuestas en este foro |