Dim mois_courant
Dim témoin, Début, Fin
'V0.1
Private Enum E_TypeConges
E_Aucun = 0
E_CP
E_RTTC
E_RTTI
E_Maladie
E_AT
E_PAT
E_SANSSOLDE
E_HR
E_ATT
E_CF
E_CET
E_FERIE
E_DEPLACEMENT
End Enum
'V0.1-fin
'V0.1
Private Sub Valider(pdtDeb As Date, pdtFin As Date, peType As E_TypeConges)
Dim Colonne As Integer
Dim oSh As Worksheet
Dim iLigFin As Integer
Dim iLig As Integer
Dim iLigDateDeb As Integer
Dim iLigDateFin As Integer
Dim dtJour As Date
Dim Ligne As Long, Choix As String
Dim NbHeure As Double, EnPlus As Double
Set oSh = Worksheets("Planning")
iLigDateDeb = -1
iLigDateFin = -1
iLigFin = oSh.Range("B" & Rows.Count).End(xlUp).Row
For iLig = 21 To iLigFin
If oSh.Range("B" & iLig).Value = pdtDeb Then
iLigDateDeb = iLig
End If
If oSh.Range("B" & iLig).Value = pdtFin Then
iLigDateFin = iLig
End If
If iLigDateDeb <> -1 And iLigDateFin <> -1 Then
Exit For
End If
Next iLig
If iLigDateDeb = -1 Then
MsgBox "Date non trouvée : " & pdtDeb, vbExclamation
Exit Sub
End If
If iLigDateFin = -1 Then
MsgBox "Date non trouvée : " & pdtFin, vbExclamation
Exit Sub
End If
If peType = E_CP Then
Choix = "CP"
ElseIf peType = E_Maladie Then
Choix = "MAL"
ElseIf peType = E_RTTC Then
Choix = "RTTC"
ElseIf peType = E_RTTI Then
Choix = "RTTI"
ElseIf peType = E_AT Then
Choix = "AT"
ElseIf peType = E_PAT Then
Choix = "PAT"
ElseIf peType = E_SANSSOLDE Then
Choix = "SANS SOLDE"
ElseIf peType = E_HR Then
Choix = "HR-"
ElseIf peType = E_ATT Then
Choix = "ATT"
ElseIf peType = E_CF Then
Choix = "CF"
ElseIf peType = E_CET Then
Choix = "CET"
ElseIf peType = E_FERIE Then
Choix = "FERIE"
ElseIf peType = E_DEPLACEMENT Then
Choix = "D"
Else
MsgBox "Type non prévu :" & peType & vbCr & "Rien ne sera inscrit", vbExclamation
Exit Sub
End If
Colonne = Me.ComboBox1.List(Me.ComboBox1.ListIndex, 1)
For iLig = iLigDateDeb To iLigDateFin
dtJour = oSh.Range("B" & iLig).Value
If Not EstFérié(dtJour) And Weekday(dtJour) <> 7 And Weekday(dtJour) <> 1 Then
'MsgBox dtJour
' Clear les colonne présence
oSh.Cells(iLig, Colonne - 1).Value = IIf(Me.Frame2.Visible = True, Val(Replace(Me.TextBox1, ",", ".")), 1)
NbHeure = NbHeure + oSh.Cells(iLig, Colonne - 1).Value
oSh.Cells(iLig, Colonne).Value = Choix
Select Case UCase(Choix)
Case "CP", "RTTC", "RTTI", "MAL", "ATT", "CF", "AT", "CET", "PAT", "FERIE"
oSh.Cells(iLig, Colonne - 2).ClearContents
Case "HR-"
If oSh.Cells(iLig, Colonne - 1) >= 3.5 Then EnPlus = 0.5
oSh.Cells(iLig, Colonne - 2) = oSh.Cells(iLig, Colonne - 2) - oSh.Cells(iLig, Colonne - 1) - EnPlus
End Select
End If
Next iLig
'genere la liste des demande d'absence
With Sheets("Demande d'absence")
.Range("A1:E1") = Array("Operateur", "Du", "Au", "Choix", "Heure/jour")
Ligne = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & Ligne) = Me.ComboBox1
.Range("B" & Ligne) = pdtDeb
.Range("C" & Ligne) = pdtFin
.Range("D" & Ligne) = Choix
'.Range("E" & Ligne) = IIf(Me.Frame2.Visible = True, NbHeure, "")
.Range("E" & Ligne) = NbHeure
.Columns("A:E").AutoFit
End With
Set oSh = Nothing
End Sub
'V0.1-fin
Private Sub B_valid_Click()
ActiveCell.Value = Me.date_début
ActiveCell.Offset(0, 1).Value = Me.date_fin
End Sub
'V0.1
Private Sub cmdQuitter_Click()
Unload Me
End Sub
'V0.1-fin
'V0.1
Private Sub cmdValider_Click()
Dim eType As E_TypeConges
'contrôles
If Me.Frame2.Visible = True And Not IsNumeric(Me.TextBox1) Then
MsgBox "Indiquer le nombre d'heure"
Me.TextBox1.SetFocus
Exit Sub
End If
If Me.ComboBox1.ListIndex = -1 Then
MsgBox "Veuillez choisir un opérateur"
Me.ComboBox1.SetFocus
Exit Sub
End If
If date_début.Text = "" Then
MsgBox "Veuillez renseigner la date de début !", vbExclamation
date_début.SetFocus
Exit Sub
End If
If Not IsDate(date_début.Text) Then
MsgBox "Date de début incorrecte !" & vbCrLf & date_début.Text, vbExclamation
date_début.SetFocus
Exit Sub
End If
If date_fin.Text = "" Then
MsgBox "Veuillez renseigner la date de fin !", vbExclamation
date_fin.SetFocus
Exit Sub
End If
If Not IsDate(date_fin.Text) Then
MsgBox "Date de fin incorrecte !" & vbCrLf & date_fin.Text, vbExclamation
date_fin.SetFocus
Exit Sub
End If
If optCP.Value Then
eType = E_CP
ElseIf optMaladie.Value Then
eType = E_Maladie
ElseIf optRTTC.Value Then
eType = E_RTTC
ElseIf optRTTI.Value Then
eType = E_RTTI
ElseIf OptAT.Value Then
eType = E_AT
ElseIf OptPAT.Value Then
eType = E_PAT
ElseIf OptSANSSOLDE.Value Then
eType = E_SANSSOLDE
ElseIf OptATT.Value Then
eType = E_ATT
ElseIf OptCF.Value Then
eType = E_CF
ElseIf OptCET.Value Then
eType = E_CET
ElseIf OptFERIE.Value Then
eType = E_FERIE
ElseIf OptDEPLACEMENT.Value Then
eType = E_DEPLACEMENT
ElseIf OptHR.Value Then
eType = E_HR
Else
eType = E_Aucun
MsgBox "Veuillez choisir le type de congés !" & vbCrLf & date_fin.Text, vbExclamation
Exit Sub
End If
Valider CDate(date_début.Text), CDate(date_fin.Text), eType
End Sub
'V0.1-fin
Private Sub OptDEPLACEMENT_Click()
Me.Frame2.Visible = False
End Sub
Private Sub OptFERIE_Click()
Me.Frame2.Visible = False
End Sub
Private Sub OptCET_Click()
Me.Frame2.Visible = False
End Sub
Private Sub OptCF_Click()
Me.Frame2.Visible = False
End Sub
Private Sub OptATT_Click()
Me.Frame2.Visible = False
End Sub
Private Sub OptAT_Click()
Me.Frame2.Visible = False
End Sub
Private Sub optCP_Click()
Me.Frame2.Visible = False
End Sub
Private Sub OptHR_Click()
Me.Frame2.Visible = True
End Sub
Private Sub optMaladie_Click()
Me.Frame2.Visible = False
End Sub
Private Sub OptPAT_Click()
Me.Frame2.Visible = False
End Sub
Private Sub optRTTC_Click()
Me.Frame2.Visible = False
End Sub
Private Sub optRTTI_Click()
Me.Frame2.Visible = False
End Sub
Private Sub OptSANSSOLDE_Click()
Me.Frame2.Visible = True
End Sub
Private Sub UserForm_Initialize()
Dim décal
Dim Depart As String, Cel As Range
Me.Frame2.Visible = False
affiche_calendrier (Date)
mois_courant = Date
décal = Weekday(DateSerial(Year(mois_courant), Month(mois_courant), 1), vbMonday) - 1
Me.Mois = Application.Proper(Format(Date, "mmmm yy"))
With Me.ComboBox1
.ColumnCount = 2
.ColumnWidths = "-1;0"
Set Cel = Sheets("Planning").Rows(19).Find(what:="*", LookIn:=xlValues, lookat:=xlWhole)
If Not Cel Is Nothing Then
Depart = Cel.Address
Do
If Cel.Column > 4 And Trim(Cel) <> "" Then
.AddItem Trim(Cel)
.List(.ListCount - 1, 1) = Cel.Column + 2
End If
Set Cel = Sheets("Planning").Rows(19).FindNext(Cel)
Loop While Depart <> Cel.Address
End If
End With
End Sub
Function pression(no_cellule)
Dim K, décal
décal = Weekday(DateSerial(Year(mois_courant), Month(mois_courant), 1)) - 2
If décal = -1 Then décal = 6
If témoin = 0 Then
raz
Me("texte" & no_cellule).BackColor = 65535
Début = no_cellule
témoin = 1
Me.date_début = DateSerial(Year(mois_courant), Month(mois_courant), Début - décal) ' date début
Me.date_fin = Null
Else
d = DateSerial(Year(mois_courant), Month(mois_courant), no_cellule - décal)
'If no_cellule < Début Then
If d < CDate(Me.date_début) Then
Début = no_cellule
raz
Me("texte" & no_cellule).BackColor = 65535
Else
Fin = no_cellule
Me.date_fin = DateSerial(Year(mois_courant), Month(mois_courant), Fin - décal) ' date fin
raz
If Month(Me.date_début) = Month(Me.date_fin) Then
For K = Début To Fin
'If Me("texte" & K).BackColor = vbWhite Then
Me("texte" & K).BackColor = 65535
'End If
Next K
Else
For K = 1 To Fin
'If Me("texte" & K).BackColor = vbWhite Then
Me("texte" & K).BackColor = 65535
'End If
Next K
End If
témoin = 0
End If
End If
End Function
Sub affiche_calendrier(dt)
Dim premier_jour_mois, premier_jour_mois_suiv, décal, nb_jours, i
premier_jour_mois = DateSerial(Year(dt), Month(dt), 1)
premier_jour_mois_suiv = DateAdd("m", 1, premier_jour_mois)
nb_jours = premier_jour_mois_suiv - premier_jour_mois + 1
décal = Weekday(premier_jour_mois, vbMonday) - 1
i = 1
Do While i < nb_jours
Me("texte" & i + décal).Caption = i
If EstFérié(DateSerial(Year(dt), Month(dt), i)) = True Then Me("texte" & i + décal).BackColor = vbGreen
i = i + 1
Loop
Me("texte" & Day(dt) + décal).BackColor = 255
Me.Mois = Application.Proper(Format(dt, "mmmm yy"))
End Sub
Private Sub raz_tot()
Dim i
For i = 1 To 37
Me("texte" & i).BackColor = vbWhite
Me("texte" & i).Caption = ""
Next i
For i = 1 To 35 Step 7
Me("texte" & i + 5).BackColor = vbGreen
Me("texte" & i + 6).BackColor = vbGreen
Next i
End Sub
Private Sub raz()
Dim i
For i = 1 To 37
If Me("texte" & i).BackColor = 65535 Then
Me("texte" & i).BackColor = vbWhite
End If
Next i
For i = 1 To 35 Step 7
Me("texte" & i + 5).BackColor = vbGreen
Me("texte" & i + 6).BackColor = vbGreen
Next i
End Sub
Private Sub moins_Click()
mois_courant = DateAdd("m", -1, mois_courant)
témoin = 0
Me.date_début = mois_courant
raz_tot
affiche_calendrier (mois_courant)
End Sub
Private Sub plus_Click()
mois_courant = DateAdd("m", 1, mois_courant)
raz_tot
affiche_calendrier (mois_courant)
End Sub
Private Sub texte1_Click()
pression (1)
End Sub
Private Sub texte2_Click()
pression (2)
End Sub
Private Sub texte3_Click()
pression (3)
End Sub
Private Sub texte4_Click()
pression (4)
End Sub
Private Sub texte5_Click()
pression (5)
End Sub
Private Sub texte6_Click()
pression (6)
End Sub
Private Sub texte7_Click()
pression (7)
End Sub
Private Sub texte8_Click()
pression (8)
End Sub
Private Sub texte9_Click()
pression (9)
End Sub
Private Sub texte10_Click()
pression (10)
End Sub
Private Sub texte11_Click()
pression (11)
End Sub
Private Sub texte12_Click()
pression (12)
End Sub
Private Sub texte13_Click()
pression (13)
End Sub
Private Sub texte14_Click()
pression (14)
End Sub
Private Sub texte15_Click()
pression (15)
End Sub
Private Sub texte16_Click()
pression (16)
End Sub
Private Sub texte17_Click()
pression (17)
End Sub
Private Sub texte18_Click()
pression (18)
End Sub
Private Sub texte19_Click()
pression (19)
End Sub
Private Sub texte20_Click()
pression (20)
End Sub
Private Sub texte21_Click()
pression (21)
End Sub
Private Sub texte22_Click()
pression (22)
End Sub
Private Sub texte23_Click()
pression (23)
End Sub
Private Sub texte24_Click()
pression (24)
End Sub
Private Sub texte25_Click()
pression (25)
End Sub
Private Sub texte26_Click()
pression (26)
End Sub
Private Sub texte27_Click()
pression (27)
End Sub
Private Sub texte28_Click()
pression (28)
End Sub
Private Sub texte29_Click()
pression (29)
End Sub
Private Sub texte30_Click()
pression (30)
End Sub
Private Sub texte31_Click()
pression (31)
End Sub
Private Sub texte32_Click()
pression (32)
End Sub
Private Sub texte33_Click()
pression (33)
End Sub
Private Sub texte34_Click()
pression (34)
End Sub
Private Sub texte35_Click()
pression (35)
End Sub
Private Sub texte36_Click()
pression (36)
End Sub
Private Sub texte37_Click()
pression (37)
End Sub
Function EstFérié(dt)
Static j(11), m(11), témoinjf, pâques, i
j(1) = 1: m(1) = 1
j(2) = 1: m(2) = 5
j(3) = 8: m(3) = 5
j(4) = 14: m(4) = 7
j(5) = 15: m(5) = 8
j(6) = 1: m(6) = 11
j(7) = 11: m(7) = 11
j(8) = 25: m(8) = 12
pâques = Round(DateSerial(Year(dt), 4, (234 - 11 * (Year(dt) Mod 19)) Mod 30) / 7, 0) * 7 - 6
j(9) = Day(pâques + 1): m(9) = Month(pâques + 1)
j(10) = Day(pâques + 39): m(10) = Month(pâques + 39)
j(11) = Day(pâques + 50): m(11) = Month(pâques + 50)
témoinjf = False
For i = 1 To 11
If Day(dt) = j(i) And Month(dt) = m(i) Then
témoinjf = True
End If
Next
EstFérié = témoinjf
End Function