Sistema para control de tiempo y asistencia de personal (página 3)
Enviado por Ing.Licdo. Yunior Andrés Castillo Silverio
If va = False Then
LstTAsig.AddItem LstTurnos.Text
LstTAsig.ItemData(LstTAsig.NewIndex) = LstTurnos.ItemData(LstTurnos.ListIndex)
End If
End If
Case 2
If LstTAsig.ListIndex <> -1 Then
LstTAsig.RemoveItem (LstTAsig.ListIndex)
End If
Case 3
LstTAsig.Clear
End Select
End Sub
Private Sub Form_Load()
Set Personal = New BD_Personal
Set Turnos = New BD_Turnos
Set Asignar = New Bb_Asignaciones
Me.Top = 0
Me.Left = 0
Personal.Busqueda LstNombres, "", "", "", "", "", -1, True
End Sub
Private Sub Form_Unload(Cancel As Integer)
Retornar
End Sub
Private Sub LstNombres_DblClick()
Call CmdAceptar_Click
End Sub
Private Sub LstNombres_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call CmdAceptar_Click
End If
End Sub
Private Sub LstTurnos_DblClick()
Call CmdControles_Click(1)
End Sub
Private Sub TxtNombre_Change(Index As Integer)
Personal.Busqueda LstNombres, TxtNombre(2).Text, TxtNombre(3).Text, TxtNombre(0).Text, TxtNombre(1).Text, "", -1, True
End Sub
Private Sub TxtNombre_KeyPress(Index As Integer, KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
If Index < 3 Then
TxtNombre(Index + 1).SetFocus
Else
If LstNombres.Enabled = True Then
LstNombres.ListIndex = 0
LstNombres.SetFocus
Else
CmdCancelar.SetFocus
End If
End If
End If
End Sub
FrmCamara:
Private Sub Form_Load()
Me.Top = 200
Me.Left = 200
End Sub
FrmConsulta:
Option Explicit
Private Marcaciones As BD_Marcacion
Private Sub CmdSalir_Click()
Unload Me
End Sub
Private Sub DTPFecha_Change()
Marcaciones.LlenarListado DTPFecha.Value, LstPersonal, QueEstado
VaciarDatos
End Sub
Private Sub Form_Load()
Set Marcaciones = New BD_Marcacion
Me.Top = 0
Me.Left = 0
DTPFecha.Value = Date
DTPFecha.MaxDate = Date
Marcaciones.LlenarListado DTPFecha.Value, LstPersonal, 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
Retornar
End Sub
Private Sub LstPersonal_Click()
Dim Datos(15) As String
Dim k As Integer
VaciarDatos
Marcaciones.LLenaDatos LstPersonal.ItemData(LstPersonal.ListIndex), Datos
For k = 0 To 14
LblDatos(k).Caption = Datos(k)
Next k
End Sub
Public Sub VaciarDatos()
Dim k As Integer
For k = 0 To 14
LblDatos(k).Caption = ""
Next k
ImgIngreso.Picture = LoadPicture("")
ImgSalida.Picture = LoadPicture("")
End Sub
Private Sub Opciones_Click(Index As Integer)
Marcaciones.LlenarListado DTPFecha.Value, LstPersonal, QueEstado
VaciarDatos
End Sub
Public Function QueEstado() As Integer
If Opciones(0).Value = True Then QueEstado = 1
If Opciones(1).Value = True Then QueEstado = 2
If Opciones(2).Value = True Then QueEstado = 0
End Function
FrmFestivos:
Option Explicit
Private AuxMes As Integer
Private DiasFestivos As BD_DiasF
Private Sub C_Mes_CambiaAnyo(Index As Integer, NuevoAnyo As Integer, Cancel As Boolean)
If Index = 1 Then
If C_Mes(1).Mes = 1 Then
C_Mes(0).Anyo = NuevoAnyo – 1
C_Mes(2).Anyo = NuevoAnyo
Else
If C_Mes(1).Mes = 12 Then
C_Mes(0).Anyo = NuevoAnyo
C_Mes(2).Anyo = NuevoAnyo + 1
Else
C_Mes(0).Anyo = NuevoAnyo
C_Mes(2).Anyo = NuevoAnyo
End If
End If
If NuevoAnyo < Year(Date) Then
C_Mes(1).ColorearSel = False
Else
If NuevoAnyo = Year(Date) Then
If C_Mes(1).Mes >= Month(Date) Then
C_Mes(1).ColorearSel = True
Else
C_Mes(1).ColorearSel = False
End If
Else
C_Mes(1).ColorearSel = True
End If
End If
T_Cambio.Enabled = True
End If
End Sub
Private Sub C_Mes_CambiaMes(Index As Integer, ByVal NuevoMes As Integer, Cancel As Boolean)
Dim MM As Integer
If Index = 1 Then
If NuevoMes = 1 Then
If C_Mes(1).Mes <> 12 Then
C_Mes(0).Anyo = C_Mes(1).Anyo – 1
End If
C_Mes(0).Mes = 12
Else
C_Mes(0).Mes = NuevoMes – 1
End If
If NuevoMes = 12 Then
If C_Mes(1).Mes = 11 Then
C_Mes(2).Anyo = C_Mes(1).Anyo + 1
End If
C_Mes(2).Mes = 1
Else
C_Mes(2).Mes = NuevoMes + 1
End If
If NuevoMes = 11 Then
C_Mes(2).Anyo = C_Mes(1).Anyo
End If
If NuevoMes = 2 Then
C_Mes(0).Anyo = C_Mes(1).Anyo
End If
If NuevoMes < Month(Date) And C_Mes(1).Anyo <= Year(Date) Then
C_Mes(1).ColorearSel = False
Else
If C_Mes(1).Anyo >= Year(Date) Then
C_Mes(1).ColorearSel = True
End If
End If
T_Cambio.Enabled = True
End If
End Sub
Private Sub C_Mes_DblClick(Index As Integer, DiaClicado As Integer)
Dim NombreFecha As String
If C_Mes(1).ColorearSel = True Then
NombreFecha = InputBox("INGRESE UN NOMBRE PARA LA FECHA:" + Str(C_Mes(1).fecha), "AVISO")
If NombreFecha <> "" Then
LstDiasFestivos.AddItem Str(C_Mes(1).fecha) + " " + NombreFecha
DiasFestivos.Nuevo NombreFecha, C_Mes(1).Dia, C_Mes(1).Mes, C_Mes(1).Anyo
LstDiasFestivos.ItemData(LstDiasFestivos.NewIndex) = DiasFestivos.codigo
C_Mes(1).ColorCelda(DiasFestivos.Dia) = vbRed
End If
End If
End Sub
Private Sub C_Mes_SelChange(Index As Integer, NuevoValor As String)
Dim ii As Integer
If Index = 1 Then
If NuevoValor <> "" Then
If C_Mes(1).Mes = Month(Date) And C_Mes(1).Anyo = Year(Date) Then
If Val(NuevoValor) < Day(Date) Then
C_Mes(1).ColorearSel = False
Else
C_Mes(1).ColorearSel = True
End If
End If
If C_Mes(1).ColorCelda(Val(NuevoValor)) = vbRed Then
If DiasFestivos.BuscaFecha(Val(NuevoValor), C_Mes(1).Mes, C_Mes(2).Anyo) = True Then
For ii = 0 To LstDiasFestivos.ListCount – 1
If LstDiasFestivos.ItemData(ii) = DiasFestivos.codigo Then
LstDiasFestivos.ListIndex = ii
Exit For
End If
Next ii
Else
LstDiasFestivos.ListIndex = -1
End If
End If
End If
End If
End Sub
Private Sub CmdAceptar_Click()
Unload Me
End Sub
Private Sub CmdColoca_Click()
Call C_Mes_DblClick(1, C_Mes(1).Dia)
End Sub
Private Sub CmdQuita_Click()
Dim cc As Integer
If LstDiasFestivos.ListIndex <> -1 Then
cc = LstDiasFestivos.ItemData(LstDiasFestivos.ListIndex)
DiasFestivos.BuscaCodigo (cc)
C_Mes(1).ColorCelda(DiasFestivos.Dia) = vbWhite
DiasFestivos.Borrar cc
LstDiasFestivos.RemoveItem (LstDiasFestivos.ListIndex)
End If
End Sub
Private Sub Form_Load()
Set DiasFestivos = New BD_DiasF
Me.Top = 0
Me.Left = 0
AuxMes = Month(Date)
If AuxMes = 1 Then
C_Mes(0).Anyo = Year(Date) – 1
C_Mes(0).Mes = 12
Else
C_Mes(0).Mes = AuxMes – 1
End If
C_Mes(1).Mes = Month(Date)
If AuxMes = 12 Then
C_Mes(2).Anyo = Year(Date) + 1
C_Mes(2).Mes = 1
Else
C_Mes(2).Mes = AuxMes + 1
End If
LlenarMeses
C_Mes(1).Dia = Day(Date)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Retornar
End Sub
Private Sub T_Cambio_Timer()
T_Cambio.Enabled = False
LlenarMeses
If C_Mes(1).Mes = Month(Date) And C_Mes(1).Anyo = Year(Date) Then
C_Mes(1).Dia = Day(Date)
End If
End Sub
Private Sub LlenarMeses()
Dim ii As Integer
For ii = 0 To 2
DiasFestivos.LLenarMes C_Mes(ii)
Next
DiasFestivos.LLenarLista LstDiasFestivos, C_Mes(1).Mes, C_Mes(1).Anyo
End Sub
FrmIngreso:
Option Explicit
Private Usuario As BD_Personal
Private Sub CmdSalir_Click()
Unload Me
End Sub
Private Sub Form_Load()
Set Usuario = New BD_Personal
End Sub
Private Sub CmdAceptar_Click()
If Usuario.ClaveRepetido(TxtClave.Text) Then
UserActivo = Usuario.codigo
TipoUser = Usuario.tipo
IniciarMenu
MDIPrincipal.Show
Unload Me
Else
MsgBox "CLAVE INCORRECTA", , "AVISO"
TxtClave.Text = ""
TxtClave.SetFocus
End If
End Sub
Private Sub TxtClave_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call CmdAceptar_Click
End If
End Sub
FrmInicio:
Private Sub Form_Load()
If App.PrevInstance = True Then
End
End If
End Sub
Private Sub T_inicio_Timer()
T_inicio.Enabled = False
MDIPrincipal.Show
MDIPrincipal.SysTray1.PonerSystray
MDIPrincipal.Hide
Unload Me
End Sub
FrmPersonal:
Private Personal As BD_Personal
Private EsNuevo As Boolean
Private EsBusqueda As Boolean
Private Sub CmbTipo_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
CmdAceptar.SetFocus
End If
End Sub
Private Sub CmdAceptar_Click()
Dim CAct As Integer
If EsBusqueda = False Then
CAct = Personal.BuscaRepetido(TxtDatos(0), TxtDatos(1), TxtDatos(2), TxtDatos(3))
If (CAct <> 0 And EsNuevo = True) Or (CAct <> Personal.codigo And EsNuevo = False) Then
MsgBox "USUARIO REPETIDO POR FAVOR VERIFIQUE", , "AVISO"
TxtDatos(0).SetFocus
Exit Sub
Else
CAct = Personal.ClaveRepetido(TxtDatos(5))
If (CAct <> 0 And EsNuevo = True) Or (CAct <> 0 And CAct <> Personal.codigo And EsNuevo = False) Then
MsgBox "CONTRASEÑA REPETIDA POR FAVOR CAMBIELA", , "AVISO"
TxtDatos(5).SetFocus
Exit Sub
Else
If EsNuevo = True Then
Personal.Nuevo CmbTipo.ListIndex, TxtDatos(0), TxtDatos(1), TxtDatos(2), TxtDatos(3), TxtDatos(5), TxtDatos(4)
Else
Personal.Actualiza Personal.codigo, CmbTipo.ListIndex, TxtDatos(0), TxtDatos(1), TxtDatos(2), TxtDatos(3), TxtDatos(5), TxtDatos(4)
End If
End If
End If
Else
If LstResultado.ListIndex <> -1 Then
Personal.CRBusqueda LstResultado.ItemData(LstResultado.ListIndex)
Else
MsgBox "Escoga un resultado de busqueda", , "AVISO"
End If
End If
CargaDatos
Call CmdCancelar_Click
End Sub
Private Sub CmdCancelar_Click()
Controles True
CargaDatos
Datos False
CmdAceptar.Enabled = False
CmdCancelar.Visible = False
Navegadores True
EsNuevo = False
EsBusqueda = False
LstResultado.Visible = False
LblBusqueda.Visible = False
LstResultado.Clear
End Sub
Private Sub CmdControles_Click(Index As Integer)
Select Case Index
Case 0
Personal.Primero
Case 1
Personal.Anterior
Case 2
Personal.Siguiente
Case 3
Personal.Ultimo
End Select
CargaDatos
End Sub
Private Sub CmdSalir_Click()
Unload Me
End Sub
Private Sub CmdComandos_Click(Index As Integer)
Controles False
CmdAceptar.Enabled = True
CmdCancelar.Visible = True
Navegadores False
Select Case Index
Case 0
BorrarDatos
Datos True
TxtDatos(0).SetFocus
EsNuevo = True
Case 1
Datos True
TxtDatos(0).SetFocus
Case 2
If MsgBox("ESTA SEGURO DE ELIMINAR A: " & Personal.nombre1 & " " & Personal.apellido1, vbYesNo, "CONFIRME") = vbYes Then
Personal.Borrar Personal.codigo
Personal.Primero
CargaDatos
End If
Call CmdCancelar_Click
Case 3
LstResultado.Visible = True
LblBusqueda.Visible = True
BorrarDatos
Datos True
TxtDatos(0).SetFocus
EsBusqueda = True
End Select
End Sub
Private Sub Form_Load()
Set Personal = New BD_Personal
Me.Top = 0
Me.Left = 0
CargaDatos
Datos False
EsNuevo = False
EsBusqueda = False
End Sub
Private Sub Datos(Estado As Boolean)
Dim x As Integer
For x = 0 To 5
TxtDatos(x).Enabled = Estado
Next x
CmbTipo.Enabled = Estado
End Sub
Private Sub Navegadores(Estado As Boolean)
Dim x As Integer
For x = 0 To 3
CmdControles(x).Enabled = Estado
Next x
End Sub
Private Sub Controles(Estado As Boolean)
Dim x As Integer
For x = 0 To 3
CmdComandos(x).Enabled = Estado
Next x
End Sub
Private Sub CargaDatos()
TxtDatos(0).Text = Personal.nombre1
TxtDatos(1).Text = Personal.nombre2
TxtDatos(2).Text = Personal.apellido1
TxtDatos(3).Text = Personal.apellido2
TxtDatos(4).Text = Personal.direccion
TxtDatos(5).Text = Personal.contrasena
CmbTipo.ListIndex = Personal.tipo
End Sub
Private Sub BorrarDatos()
Dim x As Integer
For x = 0 To 5
TxtDatos(x).Text = ""
Next x
CmbTipo.ListIndex = -1
End Sub
Private Sub Form_Unload(Cancel As Integer)
Retornar
End Sub
Private Sub TxtDatos_Change(Index As Integer)
If EsBusqueda = True Then
Personal.Busqueda LstResultado, TxtDatos(0), TxtDatos(1), TxtDatos(2), TxtDatos(3), TxtDatos(4), CmbTipo.ListIndex
End If
End Sub
Private Sub TxtDatos_KeyPress(Index As Integer, KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
If Index < 5 Then
TxtDatos(Index + 1).SetFocus
End If
If Index = 5 Then
CmbTipo.SetFocus
End If
Else
Select Case Index
Case 0, 1, 2, 3
If Not (EsLetra(KeyAscii) Or KeyAscii = 8) Then
KeyAscii = 0
End If
Case 5
If Not (IsNumeric(Chr(KeyAscii))) And KeyAscii <> 8 Then
KeyAscii = 0
End If
End Select
End If
End Sub
FrmReloj:
Option Explicit
Private Sub Form_Load()
Me.Top = 0
Me.Left = 0
EnvioReloj = False
End Sub
Private Sub ChReloj_Click()
Dim i As Integer
If ChReloj.Value = 1 Then
T_Reloj.Enabled = True
CargaReloj
For i = 0 To 5
TxtReloj(i).Enabled = False
Next i
Else
T_Reloj.Enabled = False
For i = 0 To 5
TxtReloj(i).Enabled = True
Next i
TxtReloj(2).SetFocus
End If
End Sub
Private Sub CmdAceptar_Click()
Dim dat As Boolean
Dim i As Integer
dat = False
For i = 0 To 5
If TxtReloj(i).Text <> "00" Then
dat = True
Exit For
End If
Next i
If dat = True Then
For i = 0 To 5
TxtReloj(i).Enabled = False
Next i
S_Espera.Visible = True
LblEspera.Visible = True
CmdSalir.Enabled = False
CmdAceptar.Enabled = False
EnvioReloj = True
T_Espera.Enabled = True
Else
MsgBox "NO HAY UN CAMBIO REGISTRADO", , "AVISO"
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Retornar
End Sub
Private Sub T_Espera_Timer()
Dim i As Integer
T_Espera.Enabled = False
For i = 0 To 5
TxtReloj(i).Enabled = True
Next i
S_Espera.Visible = False
LblEspera.Visible = False
CmdSalir.Enabled = True
CmdAceptar.Enabled = True
EnvioReloj = False
MsgBox "NO HAY CONEXION CON EL MARCADOR", , "AVISO"
End Sub
Private Sub T_Reloj_Timer()
CargaReloj
End Sub
Private Sub CmdSalir_Click()
Unload Me
End Sub
Private Sub CargaReloj()
TxtReloj(0).Text = Second(Now)
TxtReloj(1).Text = Minute(Now)
TxtReloj(2).Text = Hour(Now)
TxtReloj(3).Text = Day(Now)
TxtReloj(4).Text = Month(Now)
TxtReloj(5).Text = Mid(Str(Year(Now)), 4, 2)
End Sub
Private Sub TxtReloj_GotFocus(Index As Integer)
TxtReloj(Index).SelStart = 0
TxtReloj(Index).SelLength = 2
End Sub
Private Sub TxtReloj_KeyPress(Index As Integer, KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
If Index = 1 Or Index = 2 Then TxtReloj(Index – 1).SetFocus
If Index = 0 Then TxtReloj(3).SetFocus
If Index = 4 Or Index = 3 Then TxtReloj(Index + 1).SetFocus
If Index = 5 Then CmdAceptar.SetFocus
Else
If TxtReloj(Index).SelLength = 2 Then
TxtReloj(Index).Text = ""
End If
If Not (IsNumeric(Chr(KeyAscii))) And KeyAscii <> 8 Then
KeyAscii = 0
Else
If Index = 2 Then _
If Val(TxtReloj(Index).Text + Chr(KeyAscii)) > 23 Then KeyAscii = 0
If Index = 0 Or Index = 1 Then _
If Val(TxtReloj(Index).Text + Chr(KeyAscii)) > 59 Then KeyAscii = 0
If Index = 3 Then _
If Val(TxtReloj(Index).Text + Chr(KeyAscii)) > 31 Then KeyAscii = 0
If Index = 4 Then _
If Val(TxtReloj(Index).Text + Chr(KeyAscii)) > 12 Then KeyAscii = 0
End If
End If
End Sub
Private Sub TxtReloj_LostFocus(Index As Integer)
If TxtReloj(Index).Text = "" Then
TxtReloj(Index).Text = "00"
End If
If Val(TxtReloj(Index).Text) < 10 Then
TxtReloj(Index).Text = "0" + CStr(Val(TxtReloj(Index).Text))
End If
End Sub
FrmReportes:
Option Explicit
Private Marcacion As BD_Marcacion
Private x As Integer
Private np As Integer
Private Largo As Variant
Private Ancho As Variant
Private y As Double
Private i As Integer
Private Sub CmdAceptar_Click()
Marcacion.LLenarReporte DtpDesde.Value, DtpHasta.Value, 1, MSFTabla
End Sub
Private Sub CmdSalir_Click()
Unload Me
End Sub
Private Sub Command1_Click()
End Sub
Private Sub Form_Load()
Dim dd As Integer
Dim i As Integer
Set Marcacion = New BD_Marcacion
Me.Top = 0
Me.Left = 0
DtpDesde.Value = "1/" + CStr(Month(Date)) + "/" + CStr(Year(Date))
DtpHasta.Value = CStr(FinDeMes(Month(Date), Year(Date))) + "/" + CStr(Month(Date)) + "/" + CStr(Year(Date))
MSFTabla.RowHeight(0) = 250
MSFTabla.ColWidth(0) = 4000
MSFTabla.ColWidth(1) = 1200
MSFTabla.ColWidth(2) = 1200
MSFTabla.ColWidth(3) = 1200
MSFTabla.ColWidth(4) = 1200
MSFTabla.TextMatrix(0, 0) = "NOMBRES"
MSFTabla.TextMatrix(0, 1) = "T.NORMAL"
MSFTabla.TextMatrix(0, 2) = "T.NOCTUR."
MSFTabla.TextMatrix(0, 3) = "T.EX. 50%"
MSFTabla.TextMatrix(0, 4) = "T.EX. 100%"
For i = 0 To 4
MSFTabla.Col = i
MSFTabla.CellAlignment = 4
MSFTabla.CellFontBold = True
MSFTabla.ColAlignment(i) = 4
Next i
End Sub
Private Sub Form_Unload(Cancel As Integer)
Retornar
End Sub
Private Sub CmdImprimir_Click()
If MSFTabla.Rows > 0 Then
x = (MSFTabla.Rows – 1) / 44
Else
x = 0
End If
If (MSFTabla.Rows – 1) – (x * 44) > 0 Then
x = x + 1
End If
If x = 0 Then
MsgBox "NO HAY REGISTROS PARA IMPRIMIR"
Else
If MsgBox("DESEA IMPRIMIR " + CStr(x) + " HOJA(S) DE REPORTE", vbYesNo, "CONFIRMACION") = vbYes Then
Largo = Printer.Height
Ancho = Printer.Width
Printer.PaperSize = vbPRPSA4
'Titulo del reporte
Printer.ScaleMode = vbCentimeters
Printer.CurrentX = 6
Printer.CurrentY = 2
Printer.Font = "Arial"
Printer.Font.Size = 20
Printer.Print "REPORTE DESDE EL" + DtpDesde.Value + " HASTA EL " + DtpHasta.Value
'Fechas del reporte
For np = 1 To x
Encabezado
Detalles
PieDePagina
Next n
Printer.EndDoc
Printer.Height = Largo
Printer.Width = Ancho
End If
End If
End Sub
Private Sub Encabezado()
'Titulos de las columnas
Printer.CurrentX = 2
Printer.CurrentY = 4
Printer.Font = "Arial"
Printer.Font.Size = 11
Printer.Print "NOMBRES NORMAL NOCTURNA EXTRA 50% EXTRA 100%"
End Sub
Private Sub Detalles()
Dim Contador As Integer
Contador = 1
'Detalles del reporte
y = 4.7
Printer.Font = "Arial"
Printer.Font.Size = 10
i = ((np – 1) * 44) + 1
While Contador < 45
Printer.CurrentX = 2.5
Printer.CurrentY = y
Printer.Print MSFTabla.TextMatrix(i, 0)
Printer.CurrentX = 4
Printer.CurrentY = y
Printer.Print MSFTabla.TextMatrix(i, 1)
Printer.CurrentX = 10
Printer.CurrentY = y
Printer.Print MSFTabla.TextMatrix(i, 2)
Printer.CurrentX = 13.5
Printer.CurrentY = y
Printer.Print MSFTabla.TextMatrix(i, 3)
Printer.CurrentX = 18
Printer.CurrentY = y
Printer.Print MSFTabla.TextMatrix(i, 4)
y = y + 0.5
Contador = Contador + 1
i = i + 1
If i = MSFTabla.Rows Then
Exit Sub
End If
Wend
End Sub
Private Sub PieDePagina()
'Pie de pagina
Printer.CurrentX = 3
Printer.CurrentY = 27
Printer.Font = "Arial"
Printer.Font.Size = 10
Printer.Print Format(Date, "Short Date")
Printer.CurrentX = 10
Printer.CurrentY = 27
Printer.Print "Pag. " + CStr(np) + " de " + CStr(x)
Printer.CurrentX = 15
Printer.CurrentY = 27
Printer.Print "Revisado por"
Printer.EndDoc
End Sub
FrmTurnos:
Option Explicit
Private Turnos As BD_Turnos
Private turno As String
Private Sub CmdCancelar_Click()
BorraDatos
CuadroControles True
CuadroHorario False
CmdSalir.Enabled = True
If Turnos.codigo <> 0 Then
LD
CuadroNavegadores True
CmdComandos(1).Enabled = True
CmdComandos(2).Enabled = True
LstTurnos.Enabled = True
End If
End Sub
Private Sub CmdComandos_Click(Index As Integer)
Dim i As Integer
Select Case Index
Case 0
CuadroControles False
CuadroNavegadores False
CuadroHorario True
CmdSalir.Enabled = False
LstTurnos.Enabled = False
BorraDatos
TxtNombre.SetFocus
Case 1
CuadroControles False
CuadroNavegadores False
CmdSalir.Enabled = False
CuadroHorario True
TxtNombre.Enabled = False
TxtDesde(0).SetFocus
Case 2
If MsgBox("VA A BORRAR EL TURNO: " + TxtNombre.Text + " ESTA SEGURO?", vbYesNo, "ATENCION") = vbYes Then
Turnos.Borrar Turnos.codigo
If Turnos.LLenarLista(LstTurnos) = False Then
BorraDatos
CuadroNavegadores False
CmdComandos(1).Enabled = False
CmdComandos(2).Enabled = False
Else
LD
End If
End If
End Select
End Sub
Private Sub CmdControles_Click(Index As Integer)
Select Case Index
Case 0
Turnos.Primero
Case 1
Turnos.Anterior
Case 2
Turnos.Siguiente
Case 3
Turnos.Ultimo
End Select
LD
End Sub
Private Sub CmdAceptar_Click()
Dim ind As Integer
Dim Listo As Boolean
Listo = False
If TxtDesde(0).Text <> "" Or TxtDesde(1).Text <> "" Then
If TxtHasta(0).Text <> "" Or TxtHasta(1).Text <> "" Then
If TxtDesde(0).Text <> TxtHasta(0) Or TxtDesde(1).Text <> TxtHasta(1) Then
If VeriHora(TxtDesde(0), TxtDesde(1), TxtHasta(0), TxtHasta(1)) = True Then
Listo = True
Else
If MsgBox("LA HORA FINAL ES MENOR QUE LA INICIAL ESTA SEGURO DE SEQUIR", vbYesNo, "AVISO") = vbYes Then
Listo = True
Else
TxtHasta(0).SetFocus
End If
End If
Else
MsgBox "LA HORA INICIAL ES IGUAL QUE LA FINAL", vbExclamation, "ATENCION"
TxtHasta(0).SetFocus
End If
Else
MsgBox "COLOQUE UNA HORA FINAL", vbExclamation, "ATENCION"
TxtHasta(0).SetFocus
End If
Else
MsgBox "COLOQUE UNA HORA INICIAL", vbExclamation, "ATENCION"
TxtDesde(0).SetFocus
End If
If Listo = True Then
turno = TxtDesde(0).Text + ":" + TxtDesde(1).Text + " +/- " + TxtDesde(2).Text _
+ " a " + TxtHasta(0).Text + ":" + TxtHasta(1).Text + " +/- " + TxtHasta(2).Text
If TxtNombre.Enabled = True Then
Turnos.Nuevo TxtNombre.Text, turno
MsgBox "INGRESADO", , "AVISO"
Else
Turnos.Actualiza Turnos.codigo, TxtNombre.Text, turno
MsgBox "ACTUALIZADO", , "AVISO"
End If
Turnos.LLenarLista LstTurnos
Call CmdCancelar_Click
End If
End Sub
Private Sub CmdSalir_Click()
Unload Me
End Sub
Private Sub Form_Load()
Set Turnos = New BD_Turnos
Me.Top = 0
Me.Left = 0
If Turnos.LLenarLista(LstTurnos) = False Then
CuadroNavegadores False
CmdComandos(1).Enabled = False
CmdComandos(2).Enabled = False
Else
LD
End If
CuadroHorario False
End Sub
Private Sub LD()
Dim j As Integer
TxtNombre.Text = Turnos.nombre
TxtDesde(0).Text = Mid(Turnos.Turno1, 1, 2)
TxtDesde(1).Text = Mid(Turnos.Turno1, 4, 2)
TxtDesde(2).Text = Mid(Turnos.Turno1, 11, 2)
TxtHasta(0).Text = Mid(Turnos.Turno1, 16, 2)
TxtHasta(1).Text = Mid(Turnos.Turno1, 19, 2)
TxtHasta(2).Text = Mid(Turnos.Turno1, 26, 2)
For j = 0 To LstTurnos.ListCount – 1
If LstTurnos.ItemData(j) = Turnos.codigo Then Exit For
Next j
LstTurnos.ListIndex = j
End Sub
Private Sub Form_Unload(Cancel As Integer)
Retornar
End Sub
Private Sub CuadroHorario(Estado As Boolean)
Dim ii As Integer
TxtNombre.Enabled = Estado
For ii = 0 To 2
TxtDesde(ii).Enabled = Estado
TxtHasta(ii).Enabled = Estado
Next ii
CmdAceptar.Enabled = Estado
CmdCancelar.Enabled = Estado
End Sub
Private Sub CuadroNavegadores(Estado As Boolean)
Dim ii As Integer
For ii = 0 To 3
CmdControles(ii).Enabled = Estado
Next ii
End Sub
Private Sub CuadroControles(Estado As Boolean)
Dim ii As Integer
For ii = 0 To 2
CmdComandos(ii).Enabled = Estado
Next ii
End Sub
Private Sub LstTurnos_Click()
If LstTurnos.ListIndex <> -1 Then
Turnos.BuscaCodigo LstTurnos.ItemData(LstTurnos.ListIndex)
LD
End If
End Sub
Private Sub TxtDesde_GotFocus(Index As Integer)
TxtDesde(Index).SelStart = 0
TxtDesde(Index).SelLength = 2
End Sub
Private Sub TxtDesde_KeyPress(Index As Integer, KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
If Index < 2 Then
TxtDesde(Index + 1).SetFocus
Else
TxtHasta(0).SetFocus
End If
Else
If TxtDesde(Index).SelLength = 2 Then
TxtDesde(Index).Text = ""
End If
If Not (IsNumeric(Chr(KeyAscii))) And KeyAscii <> 8 Then
KeyAscii = 0
Else
If Index = 0 Then
If Val(TxtDesde(0).Text + Chr(KeyAscii)) > 23 Then
KeyAscii = 0
End If
Else
If Val(TxtDesde(Index).Text + Chr(KeyAscii)) > 59 Then
KeyAscii = 0
End If
End If
End If
End If
End Sub
Private Sub TxtDesde_LostFocus(Index As Integer)
If TxtDesde(Index).Text = "" Then
TxtDesde(Index).Text = "00"
End If
If Val(TxtDesde(Index).Text) < 10 Then
TxtDesde(Index).Text = "0" + CStr(Val(TxtDesde(Index).Text))
End If
End Sub
Private Sub TxtHasta_GotFocus(Index As Integer)
TxtHasta(Index).SelStart = 0
TxtHasta(Index).SelLength = 2
End Sub
Private Sub TxtHasta_KeyPress(Index As Integer, KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
If Index < 2 Then
TxtHasta(Index + 1).SetFocus
Else
CmdAceptar.SetFocus
End If
Else
If TxtHasta(Index).SelLength = 2 Then
TxtHasta(Index).Text = ""
End If
If Not (IsNumeric(Chr(KeyAscii))) And KeyAscii <> 8 Then
KeyAscii = 0
Else
If Index = 0 Then
If Val(TxtHasta(0).Text + Chr(KeyAscii)) > 23 Then
KeyAscii = 0
End If
Else
If Val(TxtHasta(Index).Text + Chr(KeyAscii)) > 59 Then
KeyAscii = 0
End If
End If
End If
End If
End Sub
Private Sub TxtHasta_LostFocus(Index As Integer)
If TxtHasta(Index).Text = "" Then
TxtHasta(Index).Text = "00"
End If
If Val(TxtHasta(Index).Text) < 10 Then
TxtHasta(Index).Text = "0" + CStr(Val(TxtHasta(Index).Text))
End If
End Sub
Private Sub TxtNombre_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
TxtDesde(0).SetFocus
End If
End Sub
Private Sub TxtNombre_Validate(Cancel As Boolean)
If TxtNombre.Text = "" Then
MsgBox "POR FAVOR INGRESE UN NOMBRE", vbExclamation, "ATENCION"
Cancel = True
End If
End Sub
Private Sub BorraDatos()
Dim j As Integer
TxtNombre.Text = ""
For j = 0 To 2
TxtDesde(j).Text = "00"
TxtHasta(j).Text = "00"
Next j
End Sub
MDIPrincipal:
Option Explicit
Public Marcaciones As BD_Marcacion
Private ConteoB As Integer
Private Sub M_H_Asignar_Click()
Menus False
Ancho = 9200
Largo = 8350
Me.Height = Largo
Me.Width = Ancho
FrmAsignaciones.Show
End Sub
Private Sub M_H_G_DiasF_Click()
Menus False
Ancho = 9250
Largo = 8400
Me.Height = Largo
Me.Width = Ancho
FrmFestivos.Show
End Sub
Private Sub M_H_G_Turnos_Click()
Menus False
Ancho = 9400
Largo = 8450
Me.Height = Largo
Me.Width = Ancho
FrmTurnos.Show
End Sub
Private Sub M_P_cambio_Click()
FrmIngreso.Show
Me.Hide
End Sub
Private Sub M_P_consulta_Click()
Menus False
Ancho = 8550
Largo = 7600
Me.Height = Largo
Me.Width = Ancho
FrmConsulta.Show
End Sub
Private Sub M_P_ingreso_Click()
Menus False
Ancho = 8490
Largo = 7590
Me.Height = Largo
Me.Width = Ancho
FrmPersonal.Show
End Sub
Private Sub M_P_Terminar_Click()
On Error Resume Next
MSmarcador.PortOpen = False
SysTray1.RemoverSystray
End
End Sub
Private Sub M_R_mensual_Click()
Menus False
Ancho = 9400
Largo = 8450
Me.Height = Largo
Me.Width = Ancho
FrmReportes.Show
End Sub
Private Sub M_reloj_Click()
Menus False
Ancho = 8170
Largo = 4300
Me.Height = Largo
Me.Width = Ancho
FrmReloj.Show
End Sub
Private Sub MDIForm_Load()
Set Marcaciones = New BD_Marcacion
Ancho = 5280
Largo = 3465
IniciarMenu
EnvioDatos = True
FrmCamara.Show
ConteoB = 1
MSmarcador.CommPort = Puerto
On Error Resume Next
MSmarcador.PortOpen = True
If Err.Number = 8002 Then MsgBox "NO ESTA CONFIGURADO UN PUERTO EL PROGRAMA NO FUNCIONARA"
End Sub
Private Sub MDIForm_Resize()
'COLOCAR AQUI EL TAMAÑO DE LA VENTANA
If Me.WindowState = 0 Then
Me.Height = Largo
Me.Width = Ancho
Me.Top = (Screen.Height – Me.Height) / 2
Me.Left = (Screen.Width – Me.Width) / 2
Else
If Me.WindowState = 2 Then Me.WindowState = 0
End If
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
MDIPrincipal.Hide
Cancel = 1
End Sub
Private Sub MSmarcador_OnComm()
If MSmarcador.CommEvent = comEvReceive Then
If Usb = False Then
Lectura = MSmarcador.Input
Else
If Mid(Lectura, 1, 1) = "C" Then
Lectura = Lectura + MSmarcador.Input
ConteoB = ConteoB + 1
If ConteoB = 8 Then
ConteoB = 1
Nc = Asc(Mid(Lectura, 2, 1))
clave = Mid(Lectura, 3, Nc + 1)
Cual = Resultado
Lectura = "0"
T_Retrazo.Enabled = True
End If
Else
If Mid(Lectura, 1, 1) = "R" Then
Lectura = Lectura + MSmarcador.Input
ConteoB = ConteoB + 1
If ConteoB = 7 Then
ConteoB = 1
IngresarDatos Mid(Lectura, 2, 6)
Lectura = "0"
End If
Else
Lectura = MSmarcador.Input
End If
End If
End If
If Lectura = "P" Then
FrmReloj.T_Espera.Enabled = False
Proc_Reloj
Proc_Datos
End If
If Lectura = "V" Then
MSmarcador.Output = "C"
End If
If Usb = False Then
If Mid(Lectura, 1, 1) = "C" Then
Nc = Asc(Mid(Lectura, 2, 1))
clave = Mid(Lectura, 3, Nc + 1)
Cual = Resultado
T_Retrazo.Enabled = True
Lectura = "0"
End If
If Mid(Lectura, 1, 1) = "R" Then
IngresarDatos Mid(Lectura, 2, 6)
End If
End If
If Lectura = "E" Then
MSmarcador.Output = "L"
End If
If Lectura = "F" Then
MSmarcador.Output = "X"
End If
If Mid(Lectura, 1, 1) = "S" Then
Cual = Consultando
T_Retrazo.Enabled = True
End If
End If
End Sub
Private Sub SysTray1_DblClick(Button As Integer)
If MDIPrincipal.Visible = False Then FrmIngreso.Show Else MDIPrincipal.SetFocus
End Sub
Private Sub T_Retrazo_Timer()
Select Case Cual
Case 0
Proc_Envio_Reloj
Case 1
Proc_Ver_Clave
Case 2
T_Retrazo.Enabled = False
MSmarcador.Output = "K"
TomaFoto
If FrmConsulta.Visible = True Then
Marcaciones.LlenarListado FrmConsulta.DTPFecha.Value, FrmConsulta.LstPersonal, FrmConsulta.QueEstado
FrmConsulta.VaciarDatos
MsgBox "SE ACTUALIZO UNA MARCACION", vbDefaultButton2, "AVISO"
End If
Case 3
Proc_Ver_Consulta
End Select
End Sub
MODULOS:
Option Explicit
Public Sub Proc_Reloj()
If EnvioReloj = True Then
r = 0
EnvioReloj = False
MDIPrincipal.MSmarcador.Output = "R"
Cual = Reloj
MDIPrincipal.T_Retrazo.Enabled = True
End If
End Sub
Public Sub Proc_Datos()
If EnvioDatos = True Then
EnvioDatos = False
MDIPrincipal.MSmarcador.Output = "D"
End If
End Sub
Public Sub Proc_Envio_Reloj()
MDIPrincipal.MSmarcador.Output = Chr(Val("&H" + FrmReloj.TxtReloj(r).Text))
r = r + 1
If r = 6 Then
MDIPrincipal.T_Retrazo.Enabled = False
FrmReloj.S_Espera.Visible = False
FrmReloj.LblEspera.Visible = False
FrmReloj.CmdSalir.Enabled = True
FrmReloj.CmdAceptar.Enabled = True
For r = 0 To 5
FrmReloj.TxtReloj(r).Enabled = True
Next r
r = 0
End If
End Sub
Public Function EsLetra(dato As Integer) As Boolean
If ((dato > 64) And (dato < 91)) Or ((dato > 96) And (dato < 123)) Or Chr(dato) = "ñ" Or Chr(dato) = "Ñ" Or dato = 95 Then
EsLetra = True
Else
EsLetra = False
End If
End Function
Public Sub Menus(Estado As Boolean)
Dim k As Integer
For k = 0 To 3
MDIPrincipal.Menu(k).Enabled = Estado
Next k
End Sub
Public Sub Retornar()
Ancho = 5280
Largo = 3465
Menus True
MDIPrincipal.Height = Largo
MDIPrincipal.Width = Ancho
End Sub
Public Sub Proc_Ver_Clave()
Dim Personal As BD_Personal
Set Personal = New BD_Personal
Dim cl As Integer
MDIPrincipal.T_Retrazo.Enabled = False
If Personal.ClaveRepetido(clave) = True Then
MDIPrincipal.MSmarcador.Output = "Y"
Else
MDIPrincipal.MSmarcador.Output = "N"
End If
clave = CStr(Personal.codigo)
End Sub
Public Sub IngresarDatos(Datos As String)
Dim ff As Integer
For ff = 0 To 5
DatoFecha(ff) = DecHexRej(Asc(Mid(Datos, ff + 1, 1)))
Next ff
MDIPrincipal.Marcaciones.IngresoMarcado Val(clave), DatoFecha
Cual = Confirmado
MDIPrincipal.T_Retrazo.Enabled = True
End Sub
Public Function DecHexRej(numero As Integer) As Integer
Dim n1 As Integer
Dim r1 As Integer
If numero > 9 Then
n1 = Int(numero / 16)
r1 = numero – (n1 * 16)
DecHexRej = (n1 * 10) + r1
Else
DecHexRej = numero
End If
End Function
Public Sub Proc_Ver_Consulta()
Dim Marca As BD_Marcacion
Set Marca = New BD_Marcacion
MDIPrincipal.T_Retrazo.Enabled = False
If Marca.Consultando(Val(clave)) = True Then
MDIPrincipal.MSmarcador.Output = "Y"
Else
MDIPrincipal.MSmarcador.Output = "N"
End If
End Sub
Public Function VeriHora(d1 As String, d2 As String, h1 As String, h2 As String) As Boolean
VeriHora = False
If Val(h1) > Val(d1) Then
VeriHora = True
End If
If Val(h1) = Val(d1) Then
If Val(h2) > Val(d2) Then
VeriHora = True
End If
End If
End Function
Public Sub TomaFoto()
Dim RutaPrograma As String
Dim RutaFotoOriginal As String
Dim RutaFotoDestino As String
Dim FotoLista As Boolean
On Error Resume Next
Kill App.Path + "fotosm" + "*.bmp"
On Error Resume Next
FotoLista = FrmCamara.ezVidCap1.CapSingleFrame
RutaFotoOriginal = App.Path + "fotosm" + CStr(NumeroMarcacion) + "_" + CStr(IngSal) + ".bmp"
Call FrmCamara.ezVidCap1.SaveDIB(RutaFotoOriginal)
If Err Then
MsgBox Err.Description, vbInformation, App.Title
End If
RutaPrograma = App.Path + "PVW32Con.exe "
RutaFotoDestino = App.Path + "fotosm "
Shell RutaPrograma + " " + RutaFotoOriginal + " -j –jq020 –o " + RutaFotoDestino, vbHide
End Sub
Public Function FinDeMes(MM As Integer, aa As Integer) As Integer
Select Case MM
Case 1, 3, 5, 7, 8, 10, 12
FinDeMes = 31
Case 2
If aa = aa – (Int(aa / 4) * 4) = 0 Then
FinDeMes = 29
Else
FinDeMes = 28
End If
Case 4, 6, 9, 11
FinDeMes = 30
End Select
End Function
Public Sub IniciarMenu()
MDIPrincipal.Menu(0).Visible = True
MDIPrincipal.Menu(1).Visible = True
MDIPrincipal.Menu(2).Visible = True
MDIPrincipal.M_R_mensual.Visible = True
MDIPrincipal.M_R_personalizado.Visible = True
Select Case TipoUser
Case 1
MDIPrincipal.Menu(0).Visible = False
MDIPrincipal.M_P_ingreso.Visible = False
MDIPrincipal.M_H_generar.Visible = False
Case 2
MDIPrincipal.Menu(0).Visible = False
MDIPrincipal.Menu(1).Visible = False
MDIPrincipal.Menu(2).Visible = False
MDIPrincipal.M_R_mensual.Visible = False
MDIPrincipal.M_R_personalizado.Visible = False
End Select
End Sub
VARIABLES:
Option Explicit
Public Const RutaConexion As String = "DSN=Personal;Password=pcv06;Persist Security Info=False"
Public EnvioReloj As Boolean
Public EnvioDatos As Boolean
Public Lectura As String
Public Enum Tipos
Reloj = 0
Resultado = 1
Confirmado = 2
Consultando = 3
End Enum
Public Cual As Tipos
Public r As Integer
Public UserActivo As Integer
Public TipoUser As Integer
Public Largo As Integer
Public Ancho As Integer
Public Nc As Integer
Public clave As String
Public DatoFecha(5) As Integer
Public Puerto As Integer
Public Usb As Boolean
Public HoraNocD As Integer
Public MinutoNocD As Integer
Public HoraNocH As Integer
Public MinutoNocH As Integer
Public SD100 As Boolean
Public NumeroMarcacion As Integer
Public IngSal As Integer
MODULOS DE CLASE
BD_Asignaciones:
Option Explicit
Private MisDatosAux As ADODB.Recordset
Private MiConexion As ADODB.Connection
Private sql As String
Private mcod_empleado As Integer
Private mcod_turno As Integer
Property Get Codigo_Empleado() As Integer
Codigo_Empleado = mcod_empleado
End Property
Property Get Codigo_Turno() As Integer
Codigo_Turno = mcod_turno
End Property
Private Sub Class_Initialize()
Set MiConexion = New ADODB.Connection
Set MisDatosAux = New ADODB.Recordset
MiConexion.ConnectionString = RutaConexion
MiConexion.Open RutaConexion
End Sub
Private Sub Class_Terminate()
MiConexion.Close
End Sub
Public Sub Nuevo(cod_empleado As Integer, cod_turno As Integer)
MiConexion.Execute "Insert into Asignaciones (cod_empleado,cod_turno) " _
& "values (" & cod_empleado & "," & cod_turno & ")"
End Sub
Public Sub Borrar(codigo As Integer)
On Error Resume Next
MiConexion.Execute "Delete from asignaciones where cod_empleado = " & codigo & ""
End Sub
Public Sub LlenarAsignaciones(codigo As Integer, lista As ListBox)
sql = "SELECT Asignaciones.cod_empleado, Asignaciones.cod_turno, Turnos.nombre " _
& "FROM Turnos INNER JOIN Asignaciones ON " _
& "Turnos.codigo = Asignaciones.cod_turno " _
& "WHERE (((Asignaciones.cod_empleado)=" & codigo & "))"
MisDatosAux.CursorType = adOpenDynamic
MisDatosAux.Open sql, MiConexion, , , adCmdText
lista.Clear
lista.Enabled = True
If Not (MisDatosAux.EOF = True And MisDatosAux.BOF = True) = True Then
MisDatosAux.MoveFirst
While MisDatosAux.EOF = False
lista.AddItem MisDatosAux!nombre
lista.ItemData(lista.NewIndex) = MisDatosAux!cod_turno
MisDatosAux.MoveNext
Wend
End If
MisDatosAux.Close
End Sub
BD_Config:
Option Explicit
Private MisDatosAux As ADODB.Recordset
Private MiConexion As ADODB.Connection
Private sql As String
Private mpuerto As Integer
Private musb As Integer
Property Get Puerto() As Integer
Puerto = mpuerto
End Property
Property Get EsUsb() As Boolean
If musb = 0 Then
EsUsb = False
Else
EsUsb = True
End If
End Property
Private Sub Class_Initialize()
Set MiConexion = New ADODB.Connection
Set MisDatosAux = New ADODB.Recordset
MiConexion.ConnectionString = RutaConexion
MiConexion.Open RutaConexion
sql = "select * from configuracion"
MisDatosAux.CursorType = adOpenDynamic
MisDatosAux.Open sql, MiConexion, , , adCmdText
MisDatosAux.MoveFirst
mpuerto = MisDatosAux!Puerto
musb = MisDatosAux!Usb
MisDatosAux.Close
End Sub
Private Sub Class_Terminate()
MiConexion.Close
End Sub
Public Sub CambioPuerto(P As Integer)
MiConexion.Execute "Update configuracion set puerto=" & P & " where usb = " & musb & ""
mpuerto = P
End Sub
Public Sub CambioUsb(SiUsb As Boolean)
Dim indicador As Integer
If SiUsb = False Then
indicador = 0
Else
indicador = 1
End If
MiConexion.Execute "Update configuracion set usb=" & indicador & " where puerto = " & mpuerto & ""
musb = indicador
End Sub
BD_DiasF:
Option Explicit
Private MisDatos As ADODB.Recordset
Private MiConexion As ADODB.Connection
Private sql As String
Private mcodigo As Integer
Private mnombre As String
Private mdia As Integer
Private mmes As Integer
Private manio As Integer
Property Get codigo() As Integer
codigo = mcodigo
End Property
Property Get nombre() As String
nombre = mnombre
End Property
Property Get Dia() As Integer
Dia = mdia
End Property
Property Get Mes() As Integer
Mes = mmes
End Property
Property Get Anio() As Integer
Anio = manio
End Property
Private Sub Class_Initialize()
Set MiConexion = New ADODB.Connection
Set MisDatos = New ADODB.Recordset
MiConexion.ConnectionString = RutaConexion
MiConexion.Open RutaConexion
End Sub
Private Sub Class_Terminate()
MiConexion.Close
End Sub
Private Sub LlenarDatos()
With MisDatos
mcodigo = !codigo
mnombre = !nombre
mdia = !Dia
mmes = !Mes
manio = !Anio
End With
End Sub
Public Sub Nuevo(nombre As String, Dia As Integer, Mes As Integer, Anio As Integer)
Dim c As Integer
MisDatos.CursorType = adOpenDynamic
MisDatos.Open "select Codigo from DiasF order by Codigo", MiConexion, , , adCmdText
If MisDatos.EOF = True And MisDatos.BOF = True Then
c = 1
Else
MisDatos.MoveLast
c = MisDatos!codigo + 1
End If
MisDatos.Close
MiConexion.Execute "Insert into DiasF (codigo,nombre,dia,mes,anio) " _
& "values (" & c & ",'" & nombre & "'," & Dia & "," & Mes & "," & Anio & ")"
mcodigo = c
mnombre = nombre
mdia = Dia
mmes = Mes
manio = Anio
End Sub
Public Function BuscaNombre(nombre As String) As Boolean
sql = "select * from DiasF where nombre = '" & nombre & "'"
MisDatos.CursorType = adOpenDynamic
MisDatos.Open sql, MiConexion, , , adCmdText
If MisDatos.EOF = True And MisDatos.BOF = True Then
BuscaNombre = False
Else
With MisDatos
mcodigo = !codigo
mnombre = !nombre
mdia = !Dia
mmes = !Mes
manio = !Anio
End With
BuscaNombre = True
End If
MisDatos.Close
End Function
Public Function BuscaCodigo(codigo As Integer) As Boolean
sql = "select * from DiasF where codigo = " & codigo & ""
MisDatos.CursorType = adOpenDynamic
MisDatos.Open sql, MiConexion, , , adCmdText
If MisDatos.EOF = True And MisDatos.BOF = True Then
BuscaCodigo = False
Else
With MisDatos
mcodigo = !codigo
mnombre = !nombre
mdia = !Dia
mmes = !Mes
manio = !Anio
End With
BuscaCodigo = True
End If
MisDatos.Close
End Function
Public Function BuscaFecha(Dia As Integer, Mes As Integer, Anio As Integer) As Boolean
sql = "select * from DiasF where dia = " & Dia & " and mes = " & Mes & " and anio = " & Anio + 2000 & ""
MisDatos.CursorType = adOpenDynamic
MisDatos.Open sql, MiConexion, , , adCmdText
If MisDatos.EOF = True And MisDatos.BOF = True Then
BuscaFecha = False
Else
With MisDatos
mcodigo = !codigo
mnombre = !nombre
mdia = !Dia
mmes = !Mes
manio = !Anio
End With
BuscaFecha = True
End If
MisDatos.Close
End Function
Public Sub LLenarMes(Mes As CalendarioMes)
Dim m As Integer
Dim a As Integer
m = Mes.Mes
a = Mes.Anyo
sql = "select * from DiasF where mes = " & m & " and anio = " & a & " order by dia"
MisDatos.CursorType = adOpenDynamic
MisDatos.Open sql, MiConexion, , , adCmdText
If Not (MisDatos.EOF = True And MisDatos.BOF = True) = True Then
MisDatos.MoveFirst
While MisDatos.EOF = False
Mes.ColorCelda(MisDatos!Dia) = vbRed
MisDatos.MoveNext
Wend
End If
MisDatos.Close
End Sub
Public Sub LLenarLista(lista As ListBox, Mes As Integer, Anio As Integer)
Dim m As Integer
Dim a As Integer
sql = "select * from DiasF where mes = " & Mes & " and anio = " & Anio & " order by dia"
MisDatos.CursorType = adOpenDynamic
MisDatos.Open sql, MiConexion, , , adCmdText
lista.Clear
If Not (MisDatos.EOF = True And MisDatos.BOF = True) = True Then
MisDatos.MoveFirst
While MisDatos.EOF = False
lista.AddItem CStr(MisDatos!Dia) + "/" + CStr(MisDatos!Mes) + "/" + CStr(MisDatos!Anio) + " " + MisDatos!nombre
lista.ItemData(lista.NewIndex) = MisDatos!codigo
MisDatos.MoveNext
Wend
End If
MisDatos.Close
End Sub
Public Sub Borrar(codigo As Integer)
On Error Resume Next
MiConexion.Execute "Delete from DiasF where Codigo = " & codigo & ""
End Sub
BD_Marcacion:
Option Explicit
Private MisDatos As ADODB.Recordset
Private MisDatosAux As ADODB.Recordset
Private MiConexion As ADODB.Connection
Private sql As String
Private mcodigo As Integer
Private mcod_turno As Integer
Private mestado As Integer
Private mh_ex_t As Integer
Private mm_ex_t As Integer
Private mh_ex_m As Integer
Private mm_ex_m As Integer
Private mhoras_trab As Integer
Private mminutos_trab As Integer
Private mhoras_nocturnas As Integer
Private mminutos_nocturnas As Integer
Private mhora_ing As Integer
Private mminuto_ing As Integer
Private msegundo_ing As Integer
Private mdia_ing As Integer
Private mmes_ing As Integer
Private manio_ing As Integer
Private mhora_sal As Integer
Private mminuto_sal As Integer
Private msegundo_sal As Integer
Private mdia_sal As Integer
Private mmes_sal As Integer
Private manio_sal As Integer
Private mobservacion As Integer
Property Get codigo() As Integer
codigo = mcodigo
End Property
Property Get turno() As Integer
turno = mcod_turno
End Property
Property Get Estado() As Integer
Estado = mestado
End Property
Property Get Extras100() As String
Extras100 = ""
If mh_ex_t < 10 Then Extras100 = "0"
Extras100 = Extras100 + CStr(mh_ex_t) + ":"
If mm_ex_t < 10 Then Extras100 = Extras100 + "0"
Extras100 = Extras100 + CStr(mm_ex_t)
End Property
Property Get Extras50() As String
Extras50 = ""
If mh_ex_m < 10 Then Extras50 = "0"
Extras50 = Extras50 + CStr(mh_ex_m) + ":"
If mm_ex_m < 10 Then Extras50 = Extras50 + "0"
Extras50 = Extras50 + CStr(mm_ex_m)
End Property
Property Get Normal() As String
Normal = ""
If mhoras_trab < 10 Then Normal = "0"
Normal = Normal + CStr(mhoras_trab) + ":"
If mminutos_trab < 10 Then Normal = Normal + "0"
Normal = Normal + CStr(mminutos_trab)
End Property
Property Get Nocturnas() As String
Nocturnas = ""
If mhoras_nocturnas < 10 Then Nocturnas = "0"
Nocturnas = Nocturnas + CStr(mhoras_nocturnas) + ":"
If mminutos_nocturnas < 10 Then Nocturnas = Nocturnas + "0"
Nocturnas = Nocturnas + CStr(mminutos_nocturnas)
End Property
Property Get Ingreso() As String
Ingreso = ""
If mhora_ing < 10 Then Ingreso = "0"
Ingreso = Ingreso + CStr(mhora_ing) + ":"
If mminuto_ing < 10 Then Ingreso = Ingreso + "0"
Ingreso = Ingreso + CStr(mminuto_ing) + ":"
If msegundo_ing < 10 Then Ingreso = Ingreso + "0"
Ingreso = Ingreso + CStr(msegundo_ing) + " "
If mdia_ing < 10 Then Ingreso = Ingreso + "0"
Ingreso = Ingreso + CStr(mdia_ing) + "/"
If mmes_ing < 10 Then Ingreso = Ingreso + "0"
Ingreso = Ingreso + CStr(mmes_ing) + "/"
If manio_ing < 10 Then Ingreso = Ingreso + "0"
Ingreso = Ingreso + CStr(manio_ing)
End Property
Property Get Salida() As String
Salida = ""
If mhora_sal < 10 Then Salida = "0"
Salida = Salida + CStr(mhora_sal) + ":"
If mminuto_sal < 10 Then Salida = Salida + "0"
Salida = Salida + CStr(mminuto_sal) + ":"
If msegundo_sal < 10 Then Salida = Salida + "0"
Salida = Salida + CStr(msegundo_sal) + " "
If mdia_sal < 10 Then Salida = Salida + "0"
Salida = Salida + CStr(mdia_sal) + "/"
If mmes_sal < 10 Then Salida = Salida + "0"
Salida = Salida + CStr(mmes_sal) + "/"
If manio_sal < 10 Then Salida = Salida + "0"
Salida = Salida + CStr(manio_sal)
End Property
Property Get observacion() As Integer
observacion = mobservacion
End Property
Private Sub Class_Initialize()
Set MiConexion = New ADODB.Connection
Set MisDatos = New ADODB.Recordset
Set MisDatosAux = New ADODB.Recordset
MiConexion.ConnectionString = RutaConexion
MiConexion.Open RutaConexion
End Sub
Private Sub Class_Terminate()
MiConexion.Close
End Sub
Private Sub LlenarDatos()
With MisDatos
mcodigo = !codigo
mcod_turno = !cod_turno
mestado = !Estado
mh_ex_t = !h_ex_t
mm_ex_t = !m_ex_t
mh_ex_m = !h_ex_m
mm_ex_m = !m_ex_m
mhoras_trab = !horas_trab
mminutos_trab = !minutos_trab
mhora_ing = !hora_ing
mminuto_ing = !minuto_ing
msegundo_ing = !segundo_ing
mdia_ing = !dia_ing
mmes_ing = !men_ing
manio_ing = !anio_ing
mhora_sal = !hara_sal
mminuto_sal = !minuto_sal
msegundo_sal = !segundo_sal
mdia_sal = !dia_sal
mmes_sal = !mes_sal
manio_sal = !anio_sal
mobservacion = !observacion
End With
End Sub
Public Sub IngresoMarcado(clave As Integer, DatosFecha() As Integer)
'PROGRAMA PARA ANALIZAR DATOS Y GUARDARLOS
Dim turno As Integer
Dim numero As Integer
sql = "select * from marcacion where codigo = " & clave & " and estado = 1"
MisDatos.Open sql, MiConexion, , , adCmdText
If MisDatos.BOF = True And MisDatos.EOF = True Then
mobservacion = 0
MisDatos.Close
turno = VerTurno(clave, DatosFecha)
MisDatos.CursorType = adOpenDynamic
MisDatos.Open "select Num_Marcacion from marcacion order by Num_Marcacion", , , adCmdText
If MisDatos.BOF = True And MisDatos.EOF = True Then
NumeroMarcacion = 1
Else
MisDatos.MoveLast
NumeroMarcacion = MisDatos!Num_marcacion + 1
End If
IngSal = 1
MisDatos.Close
MiConexion.Execute "Insert into marcacion (Num_Marcacion,codigo,cod_turno,estado,hora_ing,minuto_ing," _
& "segundo_ing,dia_ing,mes_ing,anio_ing,observacion) " _
& "values (" & NumeroMarcacion & "," & clave & "," & turno & ",1," & DatosFecha(0) & "," & DatosFecha(1) & "," _
& "" & DatosFecha(2) & "," & DatosFecha(3) & "," & DatosFecha(4) & "," _
& "" & DatosFecha(5) & "," & mobservacion & ")"
Else
If VerificarCierre(clave, DatosFecha) = True Then
NumeroMarcacion = MisDatos!Num_marcacion
IngSal = 2
CerrarTurno clave, DatosFecha
MisDatos.Close
MiConexion.Execute "Update marcacion set" _
& " estado = 2, h_ex_t = " & mh_ex_t & ", " _
& " m_ex_t = " & mm_ex_t & ", h_ex_m = " & mh_ex_m & ", " _
& " m_ex_m = " & mm_ex_m & ", horas_trab = " & mhoras_trab & ", " _
& " minutos_trab = " & mminutos_trab & ", horas_nocturnas = " & mhoras_nocturnas & ", " _
& " minutos_nocturnas = " & mminutos_nocturnas & ", " _
& " hora_sal = " & DatosFecha(0) & ", minuto_sal = " & DatosFecha(1) & ", " _
& " segundo_sal = " & DatosFecha(2) & ", dia_sal = " & DatosFecha(3) & ", " _
& " mes_sal = " & DatosFecha(4) & ", anio_sal = " & DatosFecha(5) & ", " _
& " observacion = " & mobservacion & " " _
& "where codigo = " & clave & " and estado = 1"
Else
turno = MisDatos!cod_turno
MisDatos.Close
MiConexion.Execute "Update marcacion set" _
& " estado = 2, " _
& " observacion = 7 " _
& "where codigo = " & clave & " and estado = 1"
mobservacion = 0
MisDatos.CursorType = adOpenDynamic
MisDatos.Open "select Num_Marcacion from marcacion order by Num_Marcacion", , , adCmdText
If MisDatos.BOF = True And MisDatos.EOF = True Then
NumeroMarcacion = 1
Else
MisDatos.MoveLast
NumeroMarcacion = MisDatos!Num_marcacion + 1
End If
IngSal = 1
MisDatos.Close
MiConexion.Execute "Insert into marcacion (Num_Marcacion,codigo,cod_turno,estado,hora_ing,minuto_ing," _
& "segundo_ing,dia_ing,mes_ing,anio_ing,observacion) " _
& "values (" & NumeroMarcacion & "," & clave & "," & turno & ",1," & DatosFecha(0) & "," & DatosFecha(1) & "," _
& "" & DatosFecha(2) & "," & DatosFecha(3) & "," & DatosFecha(4) & "," _
& "" & DatosFecha(5) & "," & mobservacion & ")"
End If
End If
End Sub
Public Function VerTurno(cl As Integer, Hora() As Integer) As Integer
Dim HT As Double
Dim HM As Double
Dim Tol As Double
Dim Difer As Double
Dim EsAtrazo As Boolean
HM = Hora(0) + (Hora(1) / 60)
sql = "SELECT * FROM Turnos " _
& "INNER JOIN Asignaciones ON Turnos.codigo = Asignaciones.cod_turno " _
& "WHERE (((Asignaciones.cod_empleado)=" & cl & "))"
MisDatos.CursorType = adOpenDynamic
MisDatos.Open sql, MiConexion, , , adCmdText
If MisDatos.BOF = True And MisDatos.EOF = True Then
mobservacion = 1
VerTurno = -1
MisDatos.Close
Else
MisDatos.MoveFirst
Difer = 1000
While MisDatos.EOF = False
HT = MisDatos!horad1 + (MisDatos!minutod1 / 60)
Tol = MisDatos!toled1 / 60
If HM >= HT – Tol And HM <= HT + Tol Then
VerTurno = MisDatos!codigo
MisDatos.Close
Exit Function
Else
If Difer > Abs(HT – HM) Then
VerTurno = MisDatos!codigo
Difer = Abs(HT – HM)
If HT – HM > 0 Then
EsAtrazo = False
Else
EsAtrazo = True
End If
End If
End If
MisDatos.MoveNext
Wend
MisDatos.Close
If EsAtrazo = True Then
mobservacion = 2
Else
mobservacion = 4
End If
End If
End Function
Private Sub CerrarTurno(cl As Integer, Hora() As Integer)
Dim HT As Double
Dim HM As Double
Dim Tol As Double
If MisDatos!cod_turno <> -1 Then
sql = "select * from Turnos where codigo = " & MisDatos!cod_turno & ""
MisDatosAux.Open sql, MiConexion, , , adCmdText
mobservacion = MisDatos!observacion
HM = (Hora(0) + Hora(1) / 60)
HT = MisDatosAux!horah1 + (MisDatosAux!minutoh1 / 60)
Tol = MisDatosAux!toleh1 / 60
If HM >= HT – Tol And HM <= HT + Tol Then
If MisDatos!observacion = 0 Then
CalculoHoras MisDatosAux!horad1, MisDatosAux!minutod1, MisDatosAux!horah1, MisDatosAux!minutoh1, Hora
Else
CalculoHoras MisDatos!hora_ing, MisDatos!minuto_ing, Hora(0), Hora(1), Hora
End If
Else
If HM < HT Then
Select Case MisDatos!observacion
Case 0
mobservacion = 3
Case 2
mobservacion = 5
Case 4
mobservacion = 6
End Select
End If
CalculoHoras MisDatos!hora_ing, MisDatos!minuto_ing, Hora(0), Hora(1), Hora
End If
MisDatosAux.Close
Else
CalculoHoras MisDatos!hora_ing, MisDatos!minuto_ing, Hora(0), Hora(1), Hora
End If
End Sub
Private Sub CalculoHoras(HD As Integer, MD As Integer, HH As Integer, MH As Integer, fecha() As Integer)
Dim Ndias As Integer
Dim FD As String
Dim FH As String
Dim H_Desde As String
Dim H_Hasta As String
Dim HoraHasta As Integer
Dim HoraDesde As Integer
Dim Tminutos As Integer
Dim MinutosNoche As Integer
Dim k As Integer
Dim T_Aux As Integer
Dim DiasFeriados As BD_DiasF
Set DiasFeriados = New BD_DiasF
FD = CStr(MisDatos!dia_ing) + "/" + CStr(MisDatos!mes_ing) + "/" + CStr(MisDatos!anio_ing)
FH = CStr(fecha(3)) + "/" + CStr(fecha(4)) + "/" + CStr(fecha(5))
Ndias = DateDiff("d", FD, FH)
FD = CStr(HD) + ":" + CStr(MD) + ":00 " + _
CStr(MisDatos!dia_ing) + "/" + CStr(MisDatos!mes_ing) + "/" + CStr(MisDatos!anio_ing)
FH = CStr(HH) + ":" + CStr(MH) + ":00 " + _
CStr(fecha(3)) + "/" + CStr(fecha(4)) + "/" + CStr(fecha(5))
Tminutos = DateDiff("n", FD, FH)
mhoras_trab = Int(Tminutos / 60)
mminutos_trab = Tminutos – (Int(Tminutos / 60) * 60)
If Ndias = 0 Then
If ((Val(Format(FD, "w")) = 1 Or Val(Format(FD, "w")) = 7) And SD100 = True) Or DiasFeriados.BuscaFecha(fecha(3), fecha(4), fecha(5)) = True Then
mh_ex_t = mhoras_trab
mm_ex_t = mminutos_trab
mhoras_trab = 0
mminutos_trab = 0
Else
H_Desde = CStr(HoraNocD) + ":" + CStr(MinutoNocD) + ":00"
H_Hasta = CStr(MisDatos!hora_ing) + ":" + CStr(MisDatos!minuto_ing) + ":00"
If Val(DateDiff("n", H_Desde, H_Hasta)) > 0 Then
mhoras_nocturnas = mhoras_trab
mminutos_nocturnas = mminutos_trab
Else
H_Desde = CStr(fecha(0)) + ":" + CStr(fecha(1)) + ":00"
H_Hasta = CStr(HoraNocD) + ":" + CStr(MinutoNocD) + ":00"
MinutosNoche = Val(DateDiff("n", H_Hasta, H_Desde))
If MinutosNoche > 0 Then
mhoras_nocturnas = Int(MinutosNoche / 60)
mminutos_nocturnas = MinutosNoche – (mhoras_nocturnas * 60)
End If
End If
End If
Else
For k = 0 To Ndias
If k = 0 Then
H_Desde = CStr(MisDatos!hora_ing) + ":" + CStr(MisDatos!minuto_ing) + ":00"
H_Hasta = "23:59:00"
Tminutos = Val(DateDiff("n", H_Desde, H_Hasta)) + 1
If ((Val(Format(FD, "w")) = 1 Or Val(Format(FD, "w")) = 7) And SD100 = True) Or DiasFeriados.BuscaFecha(fecha(3), fecha(4), fecha(5)) = True Then
mh_ex_t = Int(Tminutos / 60)
mm_ex_t = Tminutos – (mhoras_trab * 60)
mhoras_trab = 0
mminutos_trab = 0
Else
mhoras_trab = Int(Tminutos / 60)
mminutos_trab = Tminutos – (mhoras_trab * 60)
If mhoras_trab > 8 Then
mh_ex_m = mhoras_trab – 8
mm_ex_m = mminutos_trab
mhoras_trab = 8
mminutos_trab = 0
H_Hasta = CStr(MisDatos!hora_ing + 8) + ":" + CStr(MisDatos!minuto_ing) + ":00"
Else
H_Hasta = "23:59:00"
End If
If Val(DateDiff("n", CStr(HoraNocD) + ":" + CStr(MinutoNocD), CStr(MisDatos!hora_ing) + ":" + CStr(MisDatos!minuto_ing))) > 0 Then
H_Desde = CStr(MisDatos!hora_ing) + ":" + CStr(MisDatos!minuto_ing)
Else
H_Desde = CStr(HoraNocD) + ":" + CStr(MinutoNocD)
End If
MinutosNoche = Val(DateDiff("n", H_Desde, H_Hasta)) + 1
If H_Hasta = "23:59:00" Then MinutosNoche = MinutosNoche + 1
If MinutosNoche > 0 Then
mhoras_nocturnas = Int(MinutosNoche / 60)
mminutos_nocturnas = MinutosNoche – (mhoras_nocturnas * 60)
End If
End If
Else
If k = Ndias Then
H_Desde = "00:00:00"
H_Hasta = CStr(fecha(0)) + ":" + CStr(fecha(1)) + ":00"
Tminutos = Val(DateDiff("n", H_Desde, H_Hasta))
FD = CStr(fecha(3)) + "/" + CStr(fecha(4)) + "/" + CStr(fecha(5))
If mhoras_trab = 8 Then
If ((Val(Format(FD, "w")) = 1 Or Val(Format(FD, "w")) = 7) And SD100 = True) Or DiasFeriados.BuscaFecha(fecha(3), fecha(4), fecha(5)) = True Then
mh_ex_t = mh_ex_t + Int(Tminutos / 60)
mm_ex_t = mm_ex_t + Tminutos – (mh_ex_t * 60)
If mm_ex_t >= 60 Then
mh_ex_t = mh_ex_t + Int(mm_ex_t / 60)
mm_ex_t = mm_ex_t – (Int(mm_ex_t / 60) * 60)
End If
Else
mh_ex_m = mh_ex_m + Int(Tminutos / 60)
mm_ex_m = mm_ex_m + Tminutos – (Int(Tminutos / 60) * 60)
If mm_ex_m >= 60 Then
mh_ex_m = mh_ex_m + Int(mm_ex_m / 60)
mm_ex_m = mm_ex_m – (Int(mm_ex_m / 60) * 60)
End If
End If
Else
T_Aux = (mhoras_trab * 60) + mminutos_trab
mhoras_trab = mhoras_trab + Int(Tminutos / 60)
mminutos_trab = mminutos_trab + Tminutos – (Int(Tminutos / 60) * 60)
If mminutos_trab >= 60 Then
mhoras_trab = mhoras_trab + Int(mminutos_trab / 60)
mminutos_trab = mminutos_trab – (Int(mminutos_trab / 60) * 60)
End If
If mhoras_trab > 8 Then
If ((Val(Format(FD, "w")) = 1 Or Val(Format(FD, "w")) = 7) And SD100 = True) Or DiasFeriados.BuscaFecha(fecha(3), fecha(4), fecha(5)) = True Then
mh_ex_t = mhoras_trab – 8
mm_ex_t = mminutos_trab
Else
mh_ex_m = mh_ex_m + mhoras_trab – 8
mm_ex_m = mminutos_trab
End If
mhoras_trab = 8
mminutos_trab = 0
Tminutos = 480 – T_Aux
H_Hasta = CStr(Int(Tminutos / 60)) + ":" + CStr(Tminutos – (Int(Tminutos / 60) * 60)) + ":00"
Else
H_Hasta = CStr(fecha(0)) + ":" + CStr(fecha(1)) + ":00"
End If
H_Desde = CStr(HoraNocH) + ":" + CStr(MinutoNocH) + ":00"
MinutosNoche = Val(DateDiff("n", H_Desde, H_Hasta))
If MinutosNoche > 0 Then
mhoras_nocturnas = mhoras_nocturnas + HoraNocH
mminutos_nocturnas = mminutos_nocturnas + MinutoNocH
Else
If H_Hasta = CStr(fecha(0)) + ":" + CStr(fecha(1)) + ":00" Then
mhoras_nocturnas = mhoras_nocturnas + fecha(0)
mminutos_nocturnas = mminutos_nocturnas + fecha(1)
Else
mhoras_nocturnas = mhoras_nocturnas + Int(Tminutos / 60)
mminutos_nocturnas = mminutos_nocturnas + (Tminutos – (Int(Tminutos / 60) * 60))
End If
End If
If mminutos_nocturnas >= 60 Then
mhoras_nocturnas = mhoras_nocturnas + Int(mminutos_nocturnas / 60)
mminutos_nocturnas = mminutos_nocturnas – (Int(mminutos_nocturnas / 60) * 60)
End If
End If
Else
FD = DateAdd("d", 1, FD)
If mhoras_trab = 8 Then
If ((Val(Format(FD, "w")) = 1 Or Val(Format(FD, "w")) = 7) And SD100 = True) Or DiasFeriados.BuscaFecha(Day(FD), Month(FD), Year(FD)) = True Then
mh_ex_t = mh_ex_t + 24
Else
mh_ex_m = mh_ex_m + 24
End If
Else
mhoras_trab = mhoras_trab + 24
If ((Val(Format(FD, "w")) = 1 Or Val(Format(FD, "w")) = 7) And SD100 = True) Or DiasFeriados.BuscaFecha(Day(FD), Month(FD), Year(FD)) = True Then
mh_ex_t = mhoras_trab – 8
mm_ex_t = mminutos_trab
Else
mh_ex_m = mhoras_trab – 8
mm_ex_m = mminutos_trab
End If
mhoras_trab = 8
mminutos_trab = 0
mhoras_nocturnas = mhoras_nocturnas + HoraNocH
mminutos_nocturnas = mminutos_nocturnas + MinutoNocH
End If
End If
End If
Next k
End If
End Sub
Private Function VerificarCierre(cl As Integer, Hora() As Integer) As Boolean
Dim HT As Double
Dim HM As Double
Dim Tol As Double
HM = Hora(0) + (Hora(1) / 60)
sql = "SELECT * FROM Turnos " _
& "WHERE codigo=" & MisDatos!cod_turno & ""
MisDatosAux.Open sql, MiConexion, , , adCmdText
HT = MisDatosAux!horad1 + (MisDatosAux!minutod1 / 60)
Tol = MisDatosAux!toled1 / 60
If HM >= HT – Tol And HM <= HT + Tol Then
VerificarCierre = False
Else
VerificarCierre = True
End If
MisDatosAux.Close
End Function
Public Sub LlenarListado(fecha As Date, lista As ListBox, Esta As Integer)
Dim Dia As Integer
Dim Mes As Integer
Dim Anio As Integer
Dia = Day(fecha)
Mes = Month(fecha)
Anio = Year(fecha) – 2000
lista.Clear
sql = "select marcacion.num_marcacion,marcacion.codigo," _
& "personal.nombre1,personal.nombre2,personal.apellido1,personal.apellido2 " _
& "from personal inner join marcacion on Personal.codigo = marcacion.codigo " _
& "where marcacion.dia_ing=" & Dia & " and marcacion.mes_ing=" & Mes & " and marcacion.anio_ing=" & Anio & ""
If Esta <> 0 Then sql = sql + " and estado=" & Esta & ""
sql = sql + " order by hora_ing,minuto_ing"
MisDatos.CursorType = adOpenDynamic
MisDatos.Open sql, MiConexion, , , adCmdText
If MisDatos.BOF = True And MisDatos.EOF = True Then
lista.AddItem "NO HAY REGISTROS"
lista.Enabled = False
Else
lista.Enabled = True
MisDatos.MoveFirst
While MisDatos.EOF = False
lista.AddItem MisDatos!nombre1 + " " + MisDatos!nombre2 + " " + MisDatos!apellido1 + " " + MisDatos!apellido2
lista.ItemData(lista.NewIndex) = MisDatos!Num_marcacion
MisDatos.MoveNext
Wend
End If
| Página siguiente |