Programa hecho en Visual Basic 6, para llevar el control de turnos del personal de una empresa.
El programa enlaza con una base de datos de access 2000 que es la que guarda todos los datos.
Para hacer los meses se han utilizado 12 Msflexgrid para los meses y de 7 x 6 casillas para los dias, que se cargan al iniciar el formulario y se rellenan automaticamente con los dias del año.
Se pueden colorear los días gracias a la propiedad ‘CellBackColor’ del control
Seleccionando un trabajador de la lista, nos marca en colores todo el calendario laboral y los turnos (mañana, tarde, festivo, vacacion) de ese trabajador para todos los meses. Luego estos datos se pueden exportar a excel, imprimir etc.
Para rellenar las casillas se han utilizado la siguiente función que dibuja los meses y llama a ‘rellenarMes’ que pone los dias:
Private Sub rellenarcalendario(ano) Dim a As Integer For a = 0 To 11 ' los 12 meses FLEXGRID(a).Redraw = False rellenarMES FLEXGRID(a), a + 1, ano FLEXGRID(a).Redraw = True Next End Sub
Y la funcion ‘rellenarMes’ que pone los días:
Function rellenarMES(MSF1 As MSFlexGrid, mes, ano) With MSF1 .Width = 2120 .Height = 1700 Dim a As Integer For a = 0 To 6 .ColWidth(a) = 300 Next 'poner dias de la semana en 1ª fila------ .Row = 0 .Col = 0 .Text = "L" .Col = 1 .Text = "M" .Col = 2 .Text = "X" .Col = 3 .Text = "J" .Col = 4 .Text = "V" .Col = 5 .Text = "S" .Col = 6 .Text = "D" '----------------------------------- Dim Startday As Date Dim FinalDay As Date Dim DayofWeek Dim CurYear Dim CurMonth Dim contador As Integer Dim valorcelda As Integer Startday = DateValue("1/" & mes & "/" & ano) DayofWeek = Weekday(Startday) - 1 ' primer dia de la semana = lunes CurYear = Year(Startday) CurMonth = Month(Startday) FinalDay = DateSerial(CurYear, CurMonth + 1, 1) '---------------------- borrar_casillas MSF1 Dim empezar .Row = 1 Select Case DayofWeek Case 1 .Col = 0: .Text = 1 empezar = 0 ' empezar en la siguiente celda si es lunes Case 2 .Col = 1: .Text = 1 empezar = 1 Case 3 .Col = 2: .Text = 1 empezar = 2 Case 4 .Col = 3: .Text = 1 empezar = 3 Case 5 .Col = 4: .Text = 1 empezar = 4 Case 6 .Col = 5: .Text = 1 empezar = 5 Case 0 .Col = 6: .Text = 1 ' si es domingo empezar = 6 End Select Dim b As Integer '-------------------------------------- contador = 0 For b = 1 To 6 ' filas For a = 0 To 6 ' columnas .Col = a If b = 1 And a >= empezar Then ' primera fila .Text = contador + 1 ' rellenar 1ª fila columnas 1 a 6 contador = contador + 1 End If If b > 1 Then .Row = b ' para rellenar el resto de filas .Text = contador + 1 If .Text > (FinalDay - Startday) Then ' final .Text = "" Exit For End If contador = contador + 1 valorcelda = (FinalDay - Startday) End If Next Next End With End Function