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