Sujet Précédent Sujet Suivant

Modification d'un calendrier sous ACCESS avec du VBA

alinebb Messages postés 3 Date d'inscription vendredi 4 avril 2003 Statut Membre Dernière intervention 30 avril 2003 - 30 avril 2003 à 10:36
brunohampert Messages postés 11 Date d'inscription dimanche 12 octobre 2003 Statut Membre Dernière intervention 28 octobre 2021 - 28 avril 2005 à 21:38
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, RecDetectC1 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

21 réponses

Précédent
  • 1
  • 2
Réponse 21 / 21
brunohampert Messages postés 11 Date d'inscription dimanche 12 octobre 2003 Statut Membre Dernière intervention 28 octobre 2021
28 avril 2005 à 21:38
Bonjour,

tu peux modifier le code de cette manière:

dans la table Attendance tu peux rajouter un record (ex : 3 - mission)

au niveau de l'ouverture du formulaire
Private Sub Form_Open(Cancel As Integer)

rajoute un select !

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 3
Me("C" & Format(D3, "00")).BackColor = "le code couoleur de ton choix"
Case Else
Me("C" & Format(D3, "00")).BackColor = 3355443
Me("C" & Format(D3, "00")).ForeColor = 16777215
End Select

dans la fonction
Function ThisIs()

modifier la valeur ( dans ce cas ci on passe de 3 à 4)

If TypeAttend > 3 Then

Bruno
0

Discussions similaires

Comment fonctionne la fonction FormulaR1C1
cs_razmokets -
wape -

2 réponses
fonction modulo en VBA
krisprolss -
Benouille -

2 réponses
Calendrier introuvable sous userform
drik56 -
PCPT -

18 réponses
A quoi sert la fonction Set ?
ICIoBRa -
ICIoBRa -

3 réponses
Dernière cellule non vide d'une colonne
cs_falafala -
Luigi13013 -

5 réponses
Rejoignez-nous