J'ai téléchargé un calendrier sous ACCESS avec de la programmation en VBA derrière qui selon certaines tables affiche des couleurs dans le calendrier. Ce calendrier permet par un formulaire affichant un calendrier de voir si la personne était présente ou non en formation en affichant les couleurs correspondantes.Il y a trois table:
la table Attend avec trois colonnes Att student (matricule de la personne), AttDate(date), AttType(un chiffre entre 0 et 3); la table Attendance Type avec deux colonnes: AttID (avec 0,1,2,3) et AttDesc(record, present...) et la table Students qui a deux colonnes StudentID (le matricule de la personne) et StudentName (le nom de la personne).
Il y a deux formulaire un qui doit servir pour rentrer les info et l'autre où il y a le calendrier qui a apparement du VBA:
Option Compare Database
Option Explicit
Function ThisIs()
Dim TDate As Date, C1 As Integer, StrSQL As String, TypeAttend, RecDetect
C1 = 1: TDate = Me![scr1Date]
Do Until C1 = CInt(Mid(ActiveControl.Name, 3, 2))
TDate = DateAdd("d", 1, TDate)
C1 = C1 + 1
Loop
TypeAttend = DLookup("AttType", "Attend", "[AttStudent] = " & Me![scrStudent] & " AND [AttDate] = #" & Format(TDate, "mm/dd/yy") & "#")
If IsNull(TypeAttend) Then
TypeAttend = 0
End If
TypeAttend = TypeAttend + 1
If TypeAttend > 3 Then
TypeAttend = 0
End If
RecDetect = DLookup("[scrStudent]", "Attend", "[AttStudent] = " & Me![scrStudent] & " AND [AttDate] = #" & Format(TDate, "mm/dd/yy") & "#")
If IsNull(RecDetect) Then
StrSQL = "INSERT INTO Attend ( AttStudent, AttDate, AttType ) " _
& "SELECT " & Me![scrStudent] & " AS F1, #" _
& Format(TDate, "mm/dd/yy") & "# AS F2, " & TypeAttend & " AS F3;"
DoCmd.RunSQL StrSQL
Else
StrSQL = "UPDATE Attend SET Attend.AttType = " & TypeAttend _
& " WHERE (((Attend.AttStudent)=" & Me![scrStudent] & ") AND" _
& "((Attend.AttDate)=#" & Format(TDate, "mm/dd/yy") & "#));"
DoCmd.RunSQL StrSQL
End If
Call RefDates
End Function
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyPageDown Then
Me![scrCDate] = DateAdd("m", 1, Me![scrCDate])
End If
If KeyCode = vbKeyPageUp Then
Me![scrCDate] = DateAdd("m", -1, Me![scrCDate])
End If
Call RefDates
End Sub
Private Sub Form_Open(Cancel As Integer)
Me![scrCDate] = DateSerial(Year(Date), Month(Date), 1)
Me![scrMonth] = Format(Date, "mmmm")
Me![scrYear] = Format(Date, "yyyy")
End Sub
Sub RefDates()
Dim D1 As Variant, D2 As Integer, D3 As Integer, TypeAttend
If IsNull(Me![scrStudent]) Then
MsgBox ("Selection error.@Displaying calendar data can only be done for a specific " _
& "student.@Select a student and continue.")
Exit Sub
End If
Me![scrMonth] = Format(Me![scrCDate], "mmmm")
Me![scrYear] = Format(Me![scrCDate], "yyyy")
D1 = DateSerial(Year(Me![scrCDate]), Month(Me![scrCDate]), 1)
D2 = DatePart("w", D1, vbMonday)
Do Until DatePart("w", D1, vbMonday) = 1
D1 = DateAdd("d", -1, D1)
Loop
Me![scr1Date] = D1
D3 = 1
Do Until D3 > 42
Me("C" & Format(D3, "00")) = Day(D1)
If Month(D1) <> Month(Me![scrCDate]) Then
Me("C" & Format(D3, "00")).ForeColor = 8421504
Else
Me("C" & Format(D3, "00")).ForeColor = 0
'If Me(strt).ForeColor = -2147483634 Then
End If
TypeAttend = DLookup("AttType", "Attend", "[AttStudent] = " & Me![scrStudent] & " AND [AttDate] = #" & Format(D1, "mm/dd/yy") & "#")
If IsNull(TypeAttend) Then
TypeAttend = 0
End If
Select Case TypeAttend
Case 0
Me("C" & Format(D3, "00")).BackColor = 12632256
Case 1
Me("C" & Format(D3, "00")).BackColor = 65280
Case 2
Me("C" & Format(D3, "00")).BackColor = 255
Case Else
Me("C" & Format(D3, "00")).BackColor = 3355443
Me("C" & Format(D3, "00")).ForeColor = 16777215
End Select
D3 = D3 + 1
D1 = DateAdd("d", 1, D1)
Loop
Me.Repaint
End Sub
Private Sub scrStudent_AfterUpdate()
Call RefDates
End Sub
Private Sub Command107_Click()
On Error GoTo Err_Command107_Click
DoCmd.Close
Exit_Command107_Click:
Exit Sub
Err_Command107_Click:
MsgBox Err.Description
Resume Exit_Command107_Click
End Sub
J'aimerai savoir si je rajoute des données dans la table AttType comme par exemple un chiffre 4 qui correspondrait à une autre donnée et qui serrait donc utilisait aussi dans la table Attend, comment faire pour qu'il génère une nouvelle couleur dans le calendrier.
Et deuxième question je voudrais qu'à partir de ce calendrier on puisse générer un planning de tournante de travail en 5/8 c'est à dire avec des équipes qui travaillent trois jours, qui ont deux jours de repos et qui retravaille 3 jours, si c'est possible.
Si vous ne comprennez pas j'aimerais vous envoyer la base ACCESS en ZIP mais je ne sais pas comment faire...
Merci de tout aide