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
| Sub rempl_IMS(arg) 'Remplissage automatique de l'onglet IMS de la semaine en cours + mise en forme conditionnelle des cellules
Dim kR As Long, kC As Integer
Application.ScreenUpdating = False
With Worksheets("IMS_CW" & num_sem & "_" & annee)
If arg <> "" Then
Set rech_nom = Nothing
Set rech_nom = .Range("A:A").Find(what:=nom_toolmoov & " " & pre_toolmoov, lookat:=xlWhole, MatchCase:=False)
kR = rech_nom.Row
Set rech_date = Nothing
Set rech_date = .Range("13:13").Find(what:=aujourdhui, lookat:=xlWhole, MatchCase:=False)
kC = rech_date.Column
.Unprotect "admin"
Dim clStatus, vacation, SecondeVac
vacation = SessionPlage
SecondeVac = False
clStatus = .Cells(kR, kC)
If (clStatus <> "") And (InStr(clStatus, vacation) = 0) Then
SecondeVac = True
kC = kC + 3
End If
If InStr(.Cells(kR, kC), "MAJ") = 0 Then
If SecondeVac Then
.Cells(kR, kC) = arg
Else
.Cells(kR, kC) = arg & vbLf & vacation
End If
End If
If arg = "MAJ" Then
.Cells(kR, kC + 1) = ecart & " Kg " & vbLf & commentaire
Else
.Cells(kR, kC + 1) = ecart & " Kg"
End If
Autoremplissage kC, Worksheets("IMS_CW" & num_sem & "_" & annee)
.Protect Password:="admin", DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End With
ThisWorkbook.Save
Application.ScreenUpdating = True
End Sub |
Partager