Private Sub CommandButton10_Click()
On Error GoTo ETIQUETTE
With Sheets("Programme des travaux")
Dim L As Long, C As Long
C = 4
L = Range("A36").End(xlUp).Row
Cells(L, C).Value = TextBox85.Value
Unload UserForm1
With Cells(L, C)
ActiveSheet.Unprotect
If ListBox35 = "M²" Then
.NumberFormat = "#,##0.0 ""M²"""
End If
If ListBox35 = "M³" Then
.NumberFormat = "#,##0.0 ""M³"""
End If
If ListBox35 = "Forfait" Then
.NumberFormat = "#,##0.0 ""F"""
End If
If ListBox35 = "ML" Then
.NumberFormat = "#,##0.0 ""ML"""
End If
If ListBox35 = "Unitée" Then
.NumberFormat = "#,##0.0 ""Unt."""
End If
If ListBox35 = "Tonne" Then
.NumberFormat = "#,##0.0 ""T"""
End If
If ListBox35 = "Kg" Then
.NumberFormat = "#,##0.0 ""Kg"""
End If
If ListBox35 = "Litre" Then
.NumberFormat = "#,##0.0 ""L"""
End If
End With
Dim A
A = ListBox11.Value
If Application.CountIf(Range("A39:A45"), "=" & A) = 0 Then
Range("A45").End(xlUp).Offset(1, 0) = A
End If
A = ListBox12.Value
If Application.CountIf(Range("A39:A45"), "=" & A) = 0 Then
Range("A45").End(xlUp).Offset(1, 0) = A
End If
A = ListBox13.Value
If Application.CountIf(Range("A39:A45"), "=" & A) = 0 Then
Range("A45").End(xlUp).Offset(1, 0) = A
End If
A = ListBox14.Value
If Application.CountIf(Range("A39:A45"), "=" & A) = 0 Then
Range("A45").End(xlUp).Offset(1, 0) = A
End If
A = ListBox15.Value
If Application.CountIf(Range("A39:A45"), "=" & A) = 0 Then
Range("A45").End(xlUp).Offset(1, 0) = A
End If
A = ListBox16.Value
If Application.CountIf(Range("A39:A45"), "=" & A) = 0 Then
Range("A45").End(xlUp).Offset(1, 0) = A
End If
M = ListBox27.Value
If Application.CountIf(Range("A39:A45"), "=" & M) = 0 Then
Range("A83").End(xlUp).Offset(1, 0) = M
End If
M = ListBox28.Value
If Application.CountIf(Range("A39:A45"), "=" & M) = 0 Then
Range("A83").End(xlUp).Offset(1, 0) = M
End If
M = ListBox29.Value
If Application.CountIf(Range("A39:A45"), "=" & M) = 0 Then
Range("A83").End(xlUp).Offset(1, 0) = M
End If
M = ListBox30.Value
If Application.CountIf(Range("A39:A45"), "=" & M) = 0 Then
Range("A83").End(xlUp).Offset(1, 0) = M
End If
M = ListBox31.Value
If Application.CountIf(Range("A39:A45"), "=" & M) = 0 Then
Range("A83").End(xlUp).Offset(1, 0) = M
End If
M = ListBox32.Value
If Application.CountIf(Range("A39:A45"), "=" & M) = 0 Then
Range("A83").End(xlUp).Offset(1, 0) = M
End If
M = ListBox33.Value
If Application.CountIf(Range("A39:A45"), "=" & M) = 0 Then
Range("A83").End(xlUp).Offset(1, 0) = M
End If
M = ListBox34.Value
If Application.CountIf(Range("A39:A45"), "=" & M) = 0 Then
Range("A83").End(xlUp).Offset(1, 0) = M
End If
Dim F
F = ListBox17.Value
If Application.CountIf(Range("A39:A45"), "=" & F) = 0 Then
Range("A128").End(xlUp).Offset(1, 0) = F
End If
F = ListBox18.Value
If Application.CountIf(Range("A39:A45"), "=" & F) = 0 Then
Range("A128").End(xlUp).Offset(1, 0) = F
End If
F = ListBox19.Value
If Application.CountIf(Range("A39:A45"), "=" & F) = 0 Then
Range("A128").End(xlUp).Offset(1, 0) = F
End If
F = ListBox20.Value
If Application.CountIf(Range("A39:A45"), "=" & F) = 0 Then
Range("A128").End(xlUp).Offset(1, 0) = F
End If
F = ListBox21.Value
If Application.CountIf(Range("A39:A45"), "=" & F) = 0 Then
Range("A128").End(xlUp).Offset(1, 0) = F
End If
F = ListBox22.Value
If Application.CountIf(Range("A39:A45"), "=" & F) = 0 Then
Range("A128").End(xlUp).Offset(1, 0) = F
End If
F = ListBox23.Value
If Application.CountIf(Range("A39:A45"), "=" & F) = 0 Then
Range("A128").End(xlUp).Offset(1, 0) = F
End If
F = ListBox24.Value
If Application.CountIf(Range("A39:A45"), "=" & F) = 0 Then
Range("A128").End(xlUp).Offset(1, 0) = F
End If
F = ListBox25.Value
If Application.CountIf(Range("A39:A45"), "=" & F) = 0 Then
Range("A128").End(xlUp).Offset(1, 0) = F
End If
F = ListBox26.Value
If Application.CountIf(Range("A39:A45"), "=" & F) = 0 Then
Range("A128").End(xlUp).Offset(1, 0) = F
End If
Dim W As String
Dim K As String
Dim P As String
Dim Début As Date
Dim J As Double
Dim F As Date
Dim compteur As Double
Dim x As Range
Dim Ligne
Dim Colonne
Début = DTPicker1.Value
Dim Valeur As Double
For i = 6 To 36
Durée = TextBox113.Value
If Range("D" & i) = "" And _
Range("D" & i - 1) <> "" Then
J = 0
J = (Durée.Value * 2)
Ligne = 5
Colonne = Application.Match(Me.DTPicker1 * 1, Rows(5))
If Me.ToggleButton1 = False Then
ActiveSheet.Cells(Ligne, Colonne).Offset(i - 6, 0) = 1
End If
If Me.ToggleButton1 = True Then
ActiveSheet.Cells(Ligne, Colonne).Offset(i - 6, 1).Select
ActiveCell.Offset(0, -1) = 1
End If
If Durée = 0.5 Then
Range("ZZ" & i - 1).End(xlToLeft).Select
Dim rng As Range: Set rng = Selection
With rng
.Interior.Color = showcolor
.Font.Color = showcolor
End With
Exit Sub
End If
If i = 6 Or Durée <= 2 Then
compteur = 1
End If
If i > 6 And Durée > 2 And Me.ToggleButton1 = True Or Me.ToggleButton1 = False Then
compteur = 2
End If
If Me.ToggleButton1 = True And Durée <= 2 Then
compteur = 1
End If
While compteur < J
compteur = compteur + 1
F = Range("ZZ" & i - 1).End(xlToLeft).Offset(-1 * (i - 6), 0)
P = Range("ZZ" & i - 1).End(xlToLeft).Offset(-1 * (i - 6), 7)
Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 1) = 1
W = WeekdayName(Weekday(F))
K = WeekdayName(Weekday(F))
If W = "samedi" And compteur < J Then
Range("zz" & i - 1).End(xlToLeft).Select
Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
Set rng = Selection
With rng
.Interior.Color = showcolor
.Font.Color = showcolor
End With
MsgBox "La tâche n'est pas achevée !", vbOKOnly
If Range("ZZ" & i - 1).End(xlToLeft).Offset(-1 * (i - 6), 5).Interior.Color = 255 Then
Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 7) = 1
End If
Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 5) = 1
End If
If W = "samedi" And compteur = J Then
Range("zz" & i - 1).End(xlToLeft).Select
Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
Set rng = Selection
With rng
.Interior.Color = showcolor
.Font.Color = showcolor
End With
Exit Sub
End If
Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 1).Select
If ActiveCell.Interior.Color = 255 And compteur < J Then
Range("zz" & i - 1).End(xlToLeft).Select
Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
Set rng = Selection
With rng
.Interior.Color = showcolor
.Font.Color = showcolor
End With
MsgBox "La tâche n'est pas achevée !", vbOKOnly
Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 3) = 1
End If
If ActiveCell.Interior.Color = 255 And W = "vendredi" And compteur < J Then
Range("zz" & i - 1).End(xlToLeft).Select
Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
Set rng = Selection
With rng
.Interior.Color = showcolor
.Font.Color = showcolor
End With
MsgBox "La tâche n'est pas achevée !", vbOKOnly
Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 7) = 1
End If
If ActiveCell.Interior.Color = 255 And W = "jeudi" And compteur < J Then
Pont = MsgBox("Jeudi Férié ! Voulez-Vous faire le Pont?" & vbYesNo)
If Pont = vbYes Then
Range("zz" & i - 1).End(xlToLeft).Select
Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
Set rng = Selection
With rng
.Interior.Color = showcolor
.Font.Color = showcolor
End With
MsgBox "La tâche n'est pas achevée !", vbOKOnly
Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 9) = 1
End If
If Pont = vbNo Then
Range("zz" & i - 1).End(xlToLeft).Select
Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
Set rng = Selection
With rng
.Interior.Color = showcolor
.Font.Color = showcolor
End With
MsgBox "La tâche n'est pas achevée !", vbOKOnly
Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 3) = 1
End If
End If
Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 7).Select
If ActiveCell.Interior.Color = 255 And K = "mardi" And compteur < J Then
Pont = MsgBox("Mardi Férié ! Voulez-Vous faire le Pont?" & vbYesNo)
If Pont = vbYes Then
Range("zz" & i - 1).End(xlToLeft).Select
Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
Set rng = Selection
With rng
.Interior.Color = showcolor
.Font.Color = showcolor
End With
MsgBox "La tâche n'est pas achevée !", vbOKOnly
Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 9) = 1
End If
If Pont = vbNo Then
Range("zz" & i - 1).End(xlToLeft).Select
Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
Set rng = Selection
With rng
.Interior.Color = showcolor
.Font.Color = showcolor
End With
MsgBox "La tâche n'est pas achevée !", vbOKOnly
Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 5) = 1
End If
End If
If ActiveCell.Interior.Color = 255 And compteur = J Then
Range("zz" & i - 1).End(xlToLeft).Select
Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
Set rng = Selection
With rng
.Interior.Color = showcolor
.Font.Color = showcolor
End With
End If
Wend
Range("zz" & i - 1).End(xlToLeft).Select
Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
Set rng = Selection
With rng
.Interior.Color = showcolor
.Font.Color = showcolor
End With
End If
Next i
End With
Exit Sub
ETIQUETTE: Erreur = ("Erreur, Vérifier les données" & vbOKOnly)
End Sub