Sub ActualisationActiviteQuotidenne()
Dim Lg As Integer, Col As Integer, Plan7(), Plan8(), Tb(), Result(), wb, ix, m, n, Jour
ReDim Result(1 To 300, 1 To 50)
Call DES
'report des données dans les variables tableaux
Plan7 = Feuil07.Range(Feuil07.Cells(1, 1), Feuil07.Cells(3400, 68)).Value
Plan8 = Feuil08.Range(Feuil08.Cells(1, 1), Feuil08.Cells(3400, 68)).Value
Tb = Feuil04.Range(Feuil04.Cells(6, 1), Feuil04.Cells(500, 19)).Value
'effacement des anciennes données de la feuille
Set wb = ActiveWorkbook.Worksheets(F_ActQuot): wb.Range("B7:AI306").Clear
'boucle de traitement des données du tableau Tb(tournées)
ix = 1
Call TypeTrn
For i = 1 To 300
's'il n'y a pas de tournée sur la ligne fin de traitement du tableau tournée
If Tb(i, 1) = Empty Then Exit For
'si la tournée = tournée précédente passage à la ligne suivante
If i <> 1 Then
If Tb(i, 1) = Tb(i - 1, 1) Or Tb(i, 3) = TypeTrnRegul Then
ix = ix - 1
GoTo suite
End If
End If
'affectation des données ds la tableau resultat
Result(ix, 1) = Tb(i, 3) 'type trn
Result(ix, 2) = Tb(i, 1) 'libellé trn
'boucle de traitement des données
'boucle sur les jours du mois
For k = 8 To 68 Step 2
Vartemp = Empty
'boucle sur chacun sur les 2 plannings
For l = 1 To 2
'boucle sur les lignes du planning
For j = PLPlan To 3396 Step 6
'si le code trn de planning = code trn de trn incrmentation
'traitement différent suivant le planning de la boucle
If l = 1 Then
If UCase(Plan7(j + 2, k)) = UCase(Tb(i, 2)) Then Vartemp = Vartemp + 1
Else
If UCase(Plan8(j + 2, k)) = UCase(Tb(i, 2)) Then Vartemp = Vartemp + 1
End If
Next j
Next l
'si vartemp n'est pas vide alors j'affiche result =vartemp sinon vide : traitement obligatoire sinon il y a des # dans le report des cellules
If Vartemp <> Empty Then Result(ix, Int(k / 2)) = Vartemp Else Result(ix, Int(k / 2)) = Empty
Next k
'calcul de la somme des codes trn du mois
For n = 4 To 34
If Result(ix, n) <> Empty Then Result(ix, 3) = Result(ix, n) + Result(ix, 3)
Next n
suite:
ix = ix + 1
Next i
ecart = i - ix
'report de la variable tableau ds la feuille
wb.Range("B7:AI306") = Result
'mise en forme
n = 1
DateMois = Worksheets(F_ActQuot).Cells(6, 5).Value
For m = 4 To 34
Jour = 5 + Weekday(DateMois - (4 - m), vbMonday) * 2
Set cel = Worksheets(F_Parametres).Range(Z_Param_JF).Find(DateMois - (4 - m), , xlValues, xlWhole)
Do While Result(n, 1) <> Empty
If Not cel Is Nothing Then
Worksheets(F_ActQuot).Cells(n + PLActQuot - 1, m + 1).Interior.Color = RGB(204, 204, 204)
Else
If UCase(Result(n, m)) <> UCase(Tb(n + ecart, Jour)) And Result(n, 1) = TypeTrnExploit Then
If Result(n, m) > Tb(n + ecart, Jour) Then Worksheets(F_ActQuot).Cells(n + PLActQuot - 1, m + 1).Interior.ColorIndex = 46
If Result(n, m) < Tb(n + ecart, Jour) And Result(n, m) > 0 Then Worksheets(F_ActQuot).Cells(n + PLActQuot - 1, m + 1).Interior.ColorIndex = 44
If Result(n, m) < Tb(n + ecart, Jour) And Result(n, m) = Empty Then Worksheets(F_ActQuot).Cells(n + PLActQuot - 1, m + 1).Interior.ColorIndex = 3
Else
If Weekday(DateMois - (4 - m), vbMonday) > 5 Then Worksheets(F_ActQuot).Cells(n + PLActQuot - 1, m + 1).Interior.ColorIndex = 37
End If
End If
n = n + 1
Loop
n = 1
Next m
With wb.Range("B7").CurrentRegion
.HorizontalAlignment = -4108: .VerticalAlignment = -4108
.Borders.LineStyle = 1
End With
Call ACT
End Sub
