Sub MEFExcel(ByRef TRG, ByRef NBSem, ByRef semaine)
Dim Feuildonnees As Worksheet
Dim indligne As Integer
Dim indcolonne As Integer
Dim projets(60, 3) As String
Dim charges(60, 53) As Single
Dim prestaffe(60, 53) As Integer
Dim semaines(52) As String
Dim x As Integer
Dim y As Integer
Dim i As Integer
Dim cmt As String
Set Feuildonnees = sh_donnees
Feuildonnees.Select
With Feuildonnees
If .FilterMode = True Then .ShowAllData
End With
For x = 1 To 60
projets(x, 1) = ""
projets(x, 2) = ""
projets(x, 3) = ""
For y = 1 To 53
charges(x, y) = 0
prestaffe(x, y) = 0
Next
Next
' trouver la ressource
indligne = 7
While Cells(indligne, 2) <> TRG
indligne = indligne + 1
Wend
' trouver la colonne de début
indcolonne = 16
While Cells(4, indcolonne).Interior.ColorIndex <> 6
indcolonne = indcolonne + 1
Wend
semaine = Cells(4, indcolonne)
indcolonnedeb = indcolonne
x = 1
' tant qu'on est sur la même ressource
While Cells(indligne, 2) = TRG
' on verifie que la ligne soit différente de "marge pour risque" et ""
If Cells(indligne, 7) <> "Marge pour risque" And Cells(indligne, 6) <> "" And Cells(indligne, 5) <> "fini" Then
' on remplit le tableau projets et on traite le nombre de colonnes souhaité
projets(x, 1) = Cells(indligne, 7)
If Left(Cells(indligne, 6), 2) = "P0" Or Left(Cells(indligne, 6), 2) = "R2" Or Left(Cells(indligne, 6), 2) = "A2" Then
projets(x, 1) = Left(Cells(indligne, 6), 19) & " - " & projets(x, 1)
End If
projets(x, 2) = Cells(indligne, 9)
If Cells(indligne, 11) <> "" Then
projets(x, 2) = Cells(indligne, 11) & " - " & projets(x, 2)
End If
projets(x, 3) = Cells(indligne, 13)
indcolonne = indcolonnedeb
y = 2
For i = 1 To NBSem
' par contre si on est en fin de planning on arrête
If Cells(4, indcolonne) = "" Then
Exit For
End If
' on note la semaine
semaines(i) = Cells(4, indcolonne)
' on remplit le tableau et charges
[B] If IsNumeric(Cells(indligne, indcolonne)) Then
charges(x, 1) = charges(x, 1) + Cells(indligne, indcolonne)
charges(x, y) = charges(x, y) + Cells(indligne, indcolonne)[/B]
' pré-staffé jaune
If Cells(indligne, indcolonne).Interior.ColorIndex = 6 Or Cells(indligne, indcolonne).Interior.ColorIndex = 36 Then
prestaffe(x, y) = 1
End If
' conges valides bleu
If Cells(indligne, indcolonne).Interior.ColorIndex = 8 Or Cells(indligne, indcolonne).Interior.ColorIndex = 33 Or _
Cells(indligne, indcolonne).Interior.ColorIndex = 37 Or Cells(indligne, indcolonne).Interior.ColorIndex = 42 Then
prestaffe(x, y) = 2
End If
' pré-staffé sans OM orange
If Cells(indligne, indcolonne).Interior.ColorIndex = 46 Or Cells(indligne, indcolonne).Interior.ColorIndex = 45 Or _
Cells(indligne, indcolonne).Interior.ColorIndex = 44 Or Cells(indligne, indcolonne).Interior.ColorIndex = 40 Then
prestaffe(x, y) = 3
End If
Else
Cells(indligne, indcolonne).ClearContents
End If
indcolonne = indcolonne + 1
If Cells(4, indcolonne) = Cells(4, indcolonne - 1) Then
i = i - 1
Else
y = y + 1
End If
Next
x = x + 1
End If
indligne = indligne + 1
Wend
'on crée un classeur
Workbooks.Add
Cells(1, 1) = " Projet"
Cells(1, 2) = "Module"
Cells(1, 3) = "CdP"
Columns("A:A").ColumnWidth = 33.57
Columns("B:B").ColumnWidth = 22.14
Columns("C:C").ColumnWidth = 14
Rows("1:1").Font.Bold = True
Columns("A:C").Font.Bold = True
Rows("1:1").HorizontalAlignment = xlCenter
ActiveWindow.DisplayZeros = False
y = 4
For i = 1 To NBSem
Cells(1, y) = semaines(i)
y = y + 1
Next
' tant qu'on a pas fini de traiter ses projets
x = 1
indligne = 2
While projets(x, 1) <> ""
' on affiche que si la somme de la charge est <> 0 pour la période souhaitée
If charges(x, 1) <> 0 Then
Cells(indligne, 1) = projets(x, 1)
Cells(indligne, 2) = projets(x, 2)
Cells(indligne, 3) = projets(x, 3)
y = 2
indcolonne = 4
For i = 1 To NBSem
Cells(indligne, indcolonne) = charges(x, y)
' pré-staffé jaune
If prestaffe(x, y) = 1 Then
Cells(indligne, indcolonne).Interior.ColorIndex = 36
End If
' congé validé bleu
If prestaffe(x, y) = 2 Then
Cells(indligne, indcolonne).Interior.ColorIndex = 8
End If
' pré-staffé sans OM orange
If prestaffe(x, y) = 3 Then
Cells(indligne, indcolonne).Interior.ColorIndex = 45
End If
indcolonne = indcolonne + 1
y = y + 1
Next
indligne = indligne + 1
End If
x = x + 1
Wend
LetCol = Split(Cells(1, indcolonne - 1).Address, "$")(1)
Range("A1:" & LetCol & "1").Interior.ColorIndex = 22
Range("A2:C" & indligne - 1).Interior.ColorIndex = 24
Range("A1:" & LetCol & indligne - 1).Borders.LineStyle = xlContinuous
Range("A1:" & LetCol & indligne - 1).Borders.Weight = xlMedium
If indligne - 1 > 2 Then
Range("A2:" & LetCol & indligne - 1).Borders(xlInsideHorizontal).Weight = xlThin
End If
If indcolonne - 1 > 4 Then
Range("D1:" & LetCol & indligne - 1).Borders(xlInsideVertical).Weight = xlThin
End If
Columns("D:" & LetCol).ColumnWidth = 5
Range("D2").Select
ActiveWindow.FreezePanes = True
' on enregistre le fichier avec comme nom le trigramme de la ressource traitée
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=ArboRacine & "Plannings\Plannings Ressources\" & TRG & ".xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Application.DisplayAlerts = True
ActiveWindow.Close
End Sub
