Llenar la Duración de una cita con intervalos de 10 minutos en un formulario
Pregunta pendiente por realizar.
Pregunta # 5. Llenar duración de la cita.
1 respuesta
Respuesta de Dante Amor
1
H o l a:
Anexo el código para seleccionar la duración
'
Private Sub ComboBox1_Change()
'Por.Dante Amor
'Validar horario
If ComboBox1 = "" Or IsNull(ComboBox1) Then Exit Sub
If Label2 = "" Then
MsgBox "Falta ingresar la fecha", vbExclamation, "VALIDAR HORARIO"
ComboBox1 = ""
Exit Sub
End If
If Label3 = "" Then
MsgBox "Seleccionar primero la hora", vbExclamation, "VALIDAR HORARIO"
ComboBox1 = ""
Exit Sub
End If
'
Set h1 = Sheets("INGRESAR_CITA")
Set h2 = Sheets("Agenda")
Set h3 = Sheets("horarios")
h3.Cells(2, "B") = h1.[D22]
h3.Cells(2, "C") = CDate(Format(Label3, "HH:MM"))
h3.Cells(2, "D") = "=C" & 2 & "+""00:" & ComboBox1 - 1 & """"
h3.Cells(2, "D") = h3.Cells(2, "D").Value
h3.Cells(3, "C") = "=C" & 2 & "+""00:01"""
h3.Cells(2, "C") = h3.Cells(3, "C").Value
hora = Hour(h3.Cells(2, "D"))
If Hour(h3.Cells(2, "D")) >= 19 Then
MsgBox "Horario incorrecto, la duración debe ser menor a: " & _
ComboBox1 & " minutos.", vbCritical, "ERROR AL SELECIONAR LA DURACIÓN"
ComboBox1 = ""
Exit Sub
End If
dia = Format(h1.[D22], "dddd")
If dia = "Sábado" Then
If h3.Cells(2, "D") >= h3.Cells(4, "D") Then
MsgBox "Horario incorrecto, la duración debe ser menor a: " & _
ComboBox1 & " minutos.", vbCritical, "ERROR AL SELECIONAR LA DURACIÓN"
ComboBox1 = ""
Exit Sub
End If
Else
'lunes a viernes
If (h3.Cells(2, "D") > h3.Cells(5, "C") And h3.Cells(2, "D") < h3.Cells(5, "D")) Or _
(h3.Cells(2, "C") < h3.Cells(5, "D") And h3.Cells(2, "D") > h3.Cells(5, "C")) Then
MsgBox "Horario incorrecto, la duración debe ser menor a: " & _
ComboBox1 & " minutos.", vbCritical, "ERROR AL SELECIONAR LA DURACIÓN"
ComboBox1 = ""
Exit Sub
End If
End If
'
Set r = h2.Columns("B")
Set b = r.Find(h1.[D22], LookAt:=xlWhole)
If Not b Is Nothing Then
ncell = b.Address
Do
'detalle
If (h3.Cells(2, "C") > h2.Cells(b.Row, "C") And h3.Cells(2, "C") < h2.Cells(b.Row, "D")) Or _
(H3.Cells(2, "D") > h2. Cells(b.Row, "C") And h3.Cells(2, "D") < h2. Cells(b.Row, "D")) Or _
(H2. Cells(b.Row, "C") > h3.Cells(2, "C") And h2. Cells(b.Row, "C") < h3.Cells(2, "D")) Or _
(H2. Cells(b.Row, "D") > h3.Cells(2, "C") And h2. Cells(b.Row, "D") < h3.Cells(2, "D")) Then
MsgBox "Horario incorrecto, la duración debe ser menor a: " & _
ComboBox1 & " minutos.", vbCritical, "ERROR AL SELECIONAR LA DURACIÓN"
ComboBox1 = ""
Exit Do
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
End If
End Subs a l u d o s
