1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
|
Private Sub saisie_jours()
Dim madate As Date
Dim firstday As Date
Dim prem As Integer
Dim i As Integer
Dim j As Integer
Dim qté As Integer
Dim codeSQL As String
Dim typpoint As Variant
Dim filtre As String
madate = Me.txt_dateselectionnee
'calcul du premier jour à afficher
prem = DatePart("w", madate, vbSunday) - 2
madate = DateAdd("d", -(prem + 5), madate)
firstday = madate
'rempli les champs texte contenant les num des jours
For i = 1 To 45
jour = Day(madate)
Me("J" & Format(i, "00")) = jour
madate = DateAdd("d", 1, madate)
Next i
'adapte les couleurs selon le type de pointage
madate = firstday & " 08:00:00"
i = 1
For i = 1 To 45
codeSQL = "ID_PERSO = " & Me.ID_PERSO & " And DATEDEB_POINT <= #" & madate & "# And DATEFIN_POINT >= #" & madate & "#"
typpoint = DLookup("TYPE_POINT", "POINTAGE", codeSQL)
If DatePart("w", madate, vbSunday) = 1 Or DatePart("w", madate, vbSunday) = 7 Then
Me("M" & Format(i, "00")).BackColor = 12632256
Else
If IsNull(typpoint) Then
typpoint = 0
End If
Select Case typpoint
Case 0
Me("M" & Format(i, "00")).BackColor = 255
Case 1
Me("M" & Format(i, "00")).BackColor = 16711680
Case 2
Me("M" & Format(i, "00")).BackColor = 65535
Case 3
Me("M" & Format(i, "00")).BackColor = 8454143
End Select
End If
madate = DateAdd("d", 1, madate)
Next i
End Sub |
Partager