Saisie de temps mensuel
- Clique:
- 5332
Réponse
C'est à la demande d'un ami que j'ai réalisé cet interface de saisie des temps
il permet à la fois de saisir des temps mais aussi de filtrer ceux-ci

Voici le MCD

Le formulaire en mode création

Et les sources du formulaire :
Vous pouvez me contacter si vous avez besoin de d'adapter ce code à vos besoins
il permet à la fois de saisir des temps mais aussi de filtrer ceux-ci

Voici le MCD

Le formulaire en mode création

Et les sources du formulaire :
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 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 |
Option Compare Database Dim G_AnneeMoisDefault As String Dim G_NumChantierDefault As Long Dim G_NumTypeInfoLgnDefault As Long Dim G_NumSalarieDefault As Long Private Sub CmdSel_Click() On Error GoTo Err_CmdSel_Click If Len(Me.AnneeMoisSaisie.Value) > 0 Then szAnneeMois = Me.AnneeMoisSaisie For i = 1 To 31 szdate = Format(i, "00") & "/" & Right(szAnneeMois, 2) & "/" & Left(szAnneeMois, 4) If IsDate(szdate) Then Me.Controls("Éti" & Format(i, "00")).Visible = True Me.Controls("ÉtiNum" & Format(i, "00")).Visible = True Me.Controls("Jrs" & Format(i, "00")).Visible = True lWeekDay = Weekday(CDate(szdate), vbMonday) Me.Controls("Éti" & Format(i, "00")).Caption = WeekdayName(lWeekDay, True) ' si week-end on grise la zone If lWeekDay = 6 Or lWeekDay = 7 Then Me.Controls("Jrs" & Format(i, "00")).BackColor = 8355711 Else Me.Controls("Jrs" & Format(i, "00")).BackColor = 16777215 End If Else Me.Controls("Éti" & Format(i, "00")).Visible = False Me.Controls("ÉtiNum" & Format(i, "00")).Visible = False Me.Controls("Jrs" & Format(i, "00")).Visible = False End If Next 'ensuite on applique les filtres ' l'année moi est toujours saisie szFilter = "AnneeMois='" & Replace(Me.AnneeMoisSaisie.Value, "-", "") & "'" Else 'si l'année mois n'est pas renseigné on n'affiche pas le jours (pas déterminable) For i = 1 To 31 Me.Controls("Éti" & Format(i, "00")).Visible = False Me.Controls("Éti" & Format(i, "00")).Caption = "" Me.Controls("ÉtiNum" & Format(i, "00")).Visible = True Me.Controls("Jrs" & Format(i, "00")).Visible = True Me.Controls("Jrs" & Format(i, "00")).BackColor = 16777215 Next szFilter = "1=1" End If 'ensuite on traite les autres filtres If Len(Me.NumChantierSaisie.Value) > 0 Then szFilter = szFilter & " and NumChantier=" & Me.NumChantierSaisie.Value End If If Len(Me.NumTypeInfoLgnSaisie.Value) > 0 Then szFilter = szFilter & " and NumTypeInfoLgn=" & Me.NumTypeInfoLgnSaisie.Value End If If Len(Me.NumSalarieSaisie.Value) > 0 Then szFilter = szFilter & " and NumSalarie=" & Me.NumSalarieSaisie.Value End If Me.Filter = szFilter Me.FilterOn = True 'si pas de filtre saisie on désactive le filtre If Len(szFilter) = 3 Then ' contient "1=1" Me.Filter = "" Me.FilterOn = False End If Exit_CmdSel_Click: Exit Sub Err_CmdSel_Click: MsgBox Err.Description Resume Exit_CmdSel_Click End Sub Private Sub Form_BeforeInsert(Cancel As Integer) ' on alimente les valeurs par défaut Me.NumChantier.Value = G_NumChantierDefault Me.AnneeMois.Value = Replace(G_AnneeMoisDefault, "-", "") Me.NumTypeInfoLgn.Value = G_NumTypeInfoLgnDefault Me.NumSalarie.Value = G_NumSalarieDefault End Sub Private Sub Form_Open(Cancel As Integer) ' à l'ouverture on filtre sur le mois en cours szMoisDefaut = Format(Now, "YYYY-MM") Me.AnneeMoisSaisie.Value = szMoisDefaut ' on filtre sur le mois en cours pour afficher les jours. Call CmdSel_Click End Sub Private Sub CmdUseFilterAsDefault_Click() On Error GoTo Err_CmdUseFilterAsDefault_Click G_AnneeMoisDefault = Me.AnneeMoisSaisie.Value If IsNull(Me.NumChantierSaisie.Value) Then G_NumChantierDefault = 0 Else G_NumChantierDefault = Me.NumChantierSaisie.Value End If G_NumTypeInfoLgnDefault = Me.NumTypeInfoLgnSaisie.Value G_NumSalarieDefault = Me.NumSalarieSaisie.Value Exit_CmdUseFilterAsDefault_Click: Exit Sub Err_CmdUseFilterAsDefault_Click: MsgBox Err.Description Resume Exit_CmdUseFilterAsDefault_Click End Sub |
Voici enfin les sources de l'application : www.benke.fr/images/stories/relevesheures.zip
Vous pouvez me contacter si vous avez besoin de d'adapter ce code à vos besoins