VBA/ code qui ne fonctionne pas

Fermé
François - 7 janv. 2017 à 11:01
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 - 7 janv. 2017 à 18:18
Bonjour,

Je ne comprend pas pourquoi mon code ne marche pas, pouvez vous m'aider s'il vous plait et le corriger ?

Public vision, mois, indicateurs As Variant
Public initialize As Boolean

Private Sub Worksheet_Activate()

If initialize = False Then
initialize = True
vision = Array("Globale", "Directeur", "Responsable d'équipe")
mois = Array("Année", "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Aout", "Septembre", "Octobre", "Novembre", "Décembre")
indicateurs = Array("A3", "A4", "A6", "A7", "A8", "A9", "A11", "A14", "B1", "B7", "B11", "B14", "C2", "C9")

'ComboBox1 : type de vision
Feuil1.ComboBox1.List = vision
Feuil1.ComboBox1.ListIndex = 0

'ListBox1 : choix du/des mois
Feuil1.ListBox1.List = mois
Feuil1.ListBox1.MultiSelect = fmMultiSelectMulti 'sélection multiple

'ListBox3 : choix des indicateurs
ListBox3.List = indicateurs
ListBox3.ListIndex = 0
ListBox3.MultiSelect = fmMultiSelectMulti 'sélection multiple

ListBox1.Width = 100
ListBox1.Height = 100

ListBox2.Width = 150
ListBox2.Height = 150

ListBox3.Width = 100
ListBox3.Height = 150

If ActiveSheet.ChartObjects.Count > 0 Then
ActiveSheet.ChartObjects.Delete
End If

resetIndicators
End If

End Sub

Private Sub ComboBox1_Change()
'Quand on change de type de vision, on met à jour la liste des Directeurs / Responsable d'équipes
updateComboBox2
resetIndicators
End Sub

Private Sub ComboBox2_Change()
'Quand on change l'identifiant du Directeur /Responsable d'équipe, on met à jour la liste des equipes / travailleurs
If Not ComboBox2.ListCount = 0 Then
updateListBox2
resetIndicators
End If
End Sub

Private Sub ListBox1_Change()

'Sélection de toutes les lignes si on sélectionne la vue "Année"

If Sheets("Mise en page").ListBox1.Selected(0) Then
Sheets("Mise en page").ListBox1.Selected(0) = False
Dim i As Long
For i = 1 To ListBox1.ListCount - 1
Sheets("Mise en page").ListBox1.Selected(i) = True
Next
End If


updateIndicators
drawCharts
End Sub

Private Sub CheckBox1_Ok()

End Sub

Private Sub ListBox2_Change()

'Sélection de toutes les lignes si on sélectionne "Tous"

If Sheets("Mise en page").ListBox2.Selected(0) Then
Sheets("Mise en page").ListBox2.Selected(0) = False
Dim i As Long
For i = 1 To ListBox2.ListCount - 1
Sheets("Mise en page").ListBox2.Selected(i) = True
Next
End If

updateIndicators
drawCharts
End Sub

Private Sub ListBox3_Change()
drawCharts
End Sub


Private Sub updateComboBox2()

'Par défault, vision "Globale", on efface la liste
ComboBox2.Clear
ComboBox2.Visible = False
Cells(2, 4).Value = ""

Dim choix As Variant

If (ComboBox1.Value = "Directeur") Then 'Si la vision est "Directeur"

ComboBox2.Visible = True
Cells(2, 4).Value = "Id Directeur"

'On affiche la liste des Directeurs
ComboBox2.List = getListDirector
ComboBox2.ListIndex = 0
End If

If (ComboBox1.Value = "Responsable d'équipe") Then 'Si la vision est "Responsable d'équipe"

ComboBox2.Visible = True
Cells(2, 4).Value = "Id Responsable d'équipe"

'on affiche la liste des Responsable d'équipes d'équipe
ComboBox2.List = getListTeam("")
ComboBox2.ListIndex = 0
End If

'On met à jour la liste des équipes / travailleurs
updateListBox2
End Sub

Private Sub updateListBox2()

'Par défault, vision "Globale", on efface la liste
ListBox2.Clear
ListBox2.Visible = False
Cells(2, 6).Value = ""

Dim choix As Variant
choix = Array()

If (ComboBox1.Value = "Directeur") Then
ListBox2.Visible = True

ListBox2.Width = 150
ListBox2.Height = 200
Cells(2, 6).Value = "Equipes"
'On affiche la liste des équipes du Directeur choisi

Dim director As String
director = ComboBox2.Value
choix = getListTeam(director)

ListBox2.List = choix
ListBox2.ListIndex = 0
End If

If (ComboBox1.Value = "Responsable d'équipe") Then
ListBox2.Visible = True

ListBox2.Width = 150
ListBox2.Height = 200
Cells(2, 6).Value = "Travailleurs"
'on affiche la liste des travailleurs du Responsable d'équipe choisi

Dim team As String
team = ComboBox2.Value
choix = getListWorker(team)

ListBox2.List = choix
ListBox2.ListIndex = 0
End If
End Sub

Private Sub resetIndicators()

For i = 15 To 58
Cells(i, 3).Value = ""
Next
End Sub

Private Sub updateIndicators()
Dim selectedMonth, selectedItem As Variant
ReDim selectedMonth(0 To 1)
ReDim selectedItem(0 To 1)

resetIndicators

Dim i, nbCol As Long

'liste des mois sélectionnés
For i = 1 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
'on ajoute le mois au tableau
selectedMonth(UBound(selectedMonth)) = ListBox1.List(i)
'on augmente la taille du tableau
ReDim Preserve selectedMonth(LBound(selectedMonth) To UBound(selectedMonth) + 1)
End If
Next

'liste des équipes / travaileurs sélectionnés
For i = 1 To ListBox2.ListCount - 1
If ListBox2.Selected(i) = True Then
'on ajoute le mois au tableau
selectedItem(UBound(selectedItem)) = ListBox2.List(i)
'on augmente la taille du tableau
ReDim Preserve selectedItem(LBound(selectedItem) To UBound(selectedItem) + 1)
End If
Next

'suppression de la dernière case vide de chaque tableau
ReDim Preserve selectedMonth(LBound(selectedMonth) To UBound(selectedMonth) - 1)
ReDim Preserve selectedItem(LBound(selectedItem) To UBound(selectedItem) - 1)

Dim m, it, col As Variant

Dim cols, iA, iB, iC, rT As Variant
ReDim iA(0 To 7)
ReDim iB(0 To 3)
ReDim iC(0 To 1)
ReDim rT(0 To 27)
'iA : [A3, A4, A6, A7, A8, A9, A11, A14]
'iB : [B1, B5, B6, B14]
'iC : [C2, C9]
'rT : [RTtemps1, RT %i]

'vision globale
If ComboBox1.Value = "Globale" Then
'Pour chaque mois sélectionné
For Each m In selectedMonth

If Not m = "" Then
nbCol = Sheets(m).Cells(3, Columns.Count).End(xlToLeft).Column

For i = 2 To nbCol
'indicateur A
'A3
iA(0) = iA(0) + Sheets(m).Cells(6, i).Value2
'A4
iA(1) = iA(1) + Sheets(m).Cells(6, i).Value2 * Sheets(m).Cells(7, i).Value2
'A6
iA(2) = iA(2) + Sheets(m).Cells(6, i).Value2 * Sheets(m).Cells(9, i).Value2
'A7
iA(3) = iA(3) + Sheets(m).Cells(6, i).Value2 * Sheets(m).Cells(10, i).Value2
'A8
iA(4) = iA(4) + Sheets(m).Cells(6, i).Value2 * Sheets(m).Cells(11, i).Value2
'A9
iA(5) = iA(5) + Sheets(m).Cells(12, i).Value2
'A11
iA(6) = iA(6) + Sheets(m).Cells(6, i).Value2 * Sheets(m).Cells(14, i).Value2
'A14
iA(7) = iA(7) + Sheets(m).Cells(16, i).Value2

'indicateur B
'B1
iB(0) = iB(0) + Sheets(m).Cells(110, i).Value2
'B5
iB(1) = iB(1) + Sheets(m).Cells(114, i).Value2
'B7
iB(2) = iB(2) + Sheets(m).Cells(115, i).Value2
'B14
iB(3) = iB(3) + Sheets(m).Cells(122, i).Value2

'indicateur C
'C2
iC(0) = iC(0) + Sheets(m).Cells(124, i).Value2
'C9
iC(1) = iC(1) + Sheets(m).Cells(132, i).Value2

'répartition des tâches
rT(0) = rT(0) + Sheets(m).Cells(58, i).Value2

For j = 1 To 27
rT(j) = rT(j) + Sheets(m).Cells(27 + j, i).Value2 * Sheets(m).Cells(58, i).Value2
Next
Next
End If
Next
Else 'vision Directeur et Responsable d'équipe
'Pour chaque mois sélectionné
For Each m In selectedMonth
If Not m = "" Then
For Each it In selectedItem
If Not it = "" Then

cols = getCols(m, it)

For Each col In cols

If Not col = "" Then
'indicateur A
'A3
iA(0) = iA(0) + Sheets(m).Cells(6, col).Value2
'A4
iA(1) = iA(1) + Sheets(m).Cells(6, col).Value2 * Sheets(m).Cells(7, col).Value2
'A6
iA(2) = iA(2) + Sheets(m).Cells(6, col).Value2 * Sheets(m).Cells(9, col).Value2
'A7
iA(3) = iA(3) + Sheets(m).Cells(6, col).Value2 * Sheets(m).Cells(10, col).Value2
'A8
iA(4) = iA(4) + Sheets(m).Cells(6, col).Value2 * Sheets(m).Cells(11, col).Value2
'A9
iA(5) = iA(5) + Sheets(m).Cells(12, col).Value2
'A11
iA(6) = iA(6) + Sheets(m).Cells(6, col).Value2 * Sheets(m).Cells(14, col).Value2
'A14
iA(7) = iA(7) + Sheets(m).Cells(16, col).Value2

'indicateur B
'B1
iB(0) = iB(0) + Sheets(m).Cells(110, col).Value2
'B5
iB(1) = iB(1) + Sheets(m).Cells(114, col).Value2
'B7
iB(2) = iB(2) + Sheets(m).Cells(115, col).Value2
'B14
iB(3) = iB(3) + Sheets(m).Cells(122, col).Value2

'indicateur C
'C2
iC(0) = iC(0) + Sheets(m).Cells(124, col).Value2
'C9
iC(1) = iC(1) + Sheets(m).Cells(132, col).Value2

'répartition des tâches
rT(0) = rT(0) + Sheets(m).Cells(58, col).Value2

For i = 1 To 27
rT(i) = rT(i) + Sheets(m).Cells(27 + i, col).Value2 * Sheets(m).Cells(58, col).Value2
Next
End If
Next
End If
Next
End If
Next
End If

If Not iA(0) = 0 Then
'Affichage
Cells(15, 3).Value = iA(0)
Cells(16, 3).Value = FormatDateTime(iA(1) / iA(0))
Cells(17, 3).Value = FormatDateTime(iA(2) / iA(0))
Cells(18, 3).Value = FormatDateTime(iA(3) / iA(0))
Cells(19, 3).Value = FormatDateTime(iA(4) / iA(0))
Cells(20, 3).Value = iA(5)
Cells(21, 3).Value = FormatDateTime(iA(6) / iA(0))
Cells(22, 3).Value = FormatPercent(iA(7) / iA(0))

Cells(24, 3).Value = iB(0)

If Not iB(1) = 0 Then
Cells(25, 3).Value = iB(2) / iB(1)
Else
Cells(25, 3).Value = 0
End If

If Not rT(13) = 0 Then
Cells(26, 3).Value = iB(0) / rT(13)
Else
Cells(26, 3).Value = 0
End If

If Not iB(0) = 0 Then
Cells(27, 3).Value = iB(3) / iB(0)
Else
Cells(27, 3).Value = 0
End If

Cells(29, 3).Value = iC(0) / iA(0)
Cells(30, 3).Value = iC(1)

For i = 1 To 27
Cells(31 + i, 3).Value = rT(i) / rT(0)
Next
End If
End Sub

Private Sub drawCharts()

Dim selectedMonth, selectedItem, selectedIndic As Variant
ReDim selectedMonth(0 To 0)
ReDim selectedItem(0 To 0)
ReDim selectedIndic(0 To 0)

Dim month As Long

'liste des mois sélectionnés
For i = 1 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
'on ajoute le mois au tableau
selectedMonth(UBound(selectedMonth)) = ListBox1.List(i)
'on augmente la taille du tableau
ReDim Preserve selectedMonth(LBound(selectedMonth) To UBound(selectedMonth) + 1)
End If
Next


'liste des équipes / travaileurs sélectionnés
For i = 1 To ListBox2.ListCount - 1
If ListBox2.Selected(i) = True Then
'on ajoute le mois au tableau
selectedItem(UBound(selectedItem)) = ListBox2.List(i)
'on augmente la taille du tableau
ReDim Preserve selectedItem(LBound(selectedItem) To UBound(selectedItem) + 1)
End If
Next

'liste des indicteurs sélectionnés
For i = 0 To ListBox3.ListCount - 1
If ListBox3.Selected(i) = True Then
'on ajoute l'indicateur au tableau
selectedIndic(UBound(selectedIndic)) = ListBox3.List(i)
'on augmente la taille du tableau
ReDim Preserve selectedIndic(LBound(selectedIndic) To UBound(selectedIndic) + 1)
End If
Next

If ActiveSheet.ChartObjects.Count > 0 Then
ActiveSheet.ChartObjects.Delete
End If

If Not LBound(selectedMonth) = UBound(selectedMonth) And Not LBound(selectedIndic) = UBound(selectedIndic) And (ComboBox1.Value = "Globale" Or Not LBound(selectedItem) = UBound(selectedItem)) Then

ReDim Preserve selectedMonth(LBound(selectedMonth) To UBound(selectedMonth) - 1)
If Not LBound(selectedItem) = UBound(selectedItem) Then
ReDim Preserve selectedItem(LBound(selectedItem) To UBound(selectedItem) - 1)
End If
ReDim Preserve selectedIndic(LBound(selectedIndic) To UBound(selectedIndic) - 1)

Dim myChtObj As ChartObject

' adjust the following constants as desired
Const Cht1Height As Double = 68
Const Cht1Width As Double = 400
Const Cht2Height As Double = 140
Const Cht2Width As Double = 190

Dim indicateursParMois As Collection

Dim col, j, nbCol As Long
Dim cols, iA, iB, iC, rT, tmp As Variant

'vision globale
If ComboBox1.Value = "Globale" Then
Set indicateursParMois = New Collection
'Pour chaque mois sélectionné
For month = LBound(selectedMonth) To UBound(selectedMonth)
'calcul des indiateurs pour le mois m

Dim m As String
m = selectedMonth(month)

ReDim iA(0 To 7)
ReDim iB(0 To 3)
ReDim iC(0 To 1)
ReDim rT(0 To 27)

nbCol = Sheets(m).Cells(3, Columns.Count).End(xlToLeft).Column

For i = 2 To nbCol
'indicateur A
'A3
iA(0) = iA(0) + Sheets(m).Cells(6, i).Value2
'A4
iA(1) = iA(1) + Sheets(m).Cells(6, i).Value2 * Sheets(m).Cells(7, i).Value2
'A6
iA(2) = iA(2) + Sheets(m).Cells(6, i).Value2 * Sheets(m).Cells(9, i).Value2
'A7
iA(3) = iA(3) + Sheets(m).Cells(6, i).Value2 * Sheets(m).Cells(10, i).Value2
'A8
iA(4) = iA(4) + Sheets(m).Cells(6, i).Value2 * Sheets(m).Cells(11, i).Value2
'A9
iA(5) = iA(5) + Sheets(m).Cells(12, i).Value2
'A11
iA(6) = iA(6) + Sheets(m).Cells(6, i).Value2 * Sheets(m).Cells(14, i).Value2
'A14
iA(7) = iA(7) + Sheets(m).Cells(16, i).Value2

'indicateur B
'B1
iB(0) = iB(0) + Sheets(m).Cells(110, i).Value2
'B5
iB(1) = iB(1) + Sheets(m).Cells(114, i).Value2
'B7
iB(2) = iB(2) + Sheets(m).Cells(115, i).Value2
'B14
iB(3) = iB(3) + Sheets(m).Cells(122, i).Value2

'indicateur C
'C2
iC(0) = iC(0) + Sheets(m).Cells(124, i).Value2
'C9
iC(1) = iC(1) + Sheets(m).Cells(132, i).Value2

'répartition des tâches
rT(0) = rT(0) + Sheets(m).Cells(58, i).Value2

For j = 1 To 27
rT(j) = rT(j) + Sheets(m).Cells(27 + j, i).Value2 * Sheets(m).Cells(58, i).Value2
Next
Next

If Not iA(0) = 0 Then

indicateursParMois.Add iA(0), "A3" & m
indicateursParMois.Add iA(1) / iA(0), "A4" & m
indicateursParMois.Add iA(2) / iA(0), "A6" & m
indicateursParMois.Add iA(3) / iA(0), "A7" & m
indicateursParMois.Add iA(4) / iA(0), "A8" & m
indicateursParMois.Add iA(5), "A9" & m
indicateursParMois.Add iA(6) / iA(0), "A11" & m
indicateursParMois.Add 100 * iA(7) / iA(0), "A14" & m

indicateursParMois.Add iB(0), "B1" & m

If Not iB(1) = 0 Then
indicateursParMois.Add 100 * iB(2) / iB(1), "B7" & m
Else
indicateursParMois.Add 0, "B7" & m
End If

If Not rT(13) = 0 Then
indicateursParMois.Add iB(0) / rT(13), "B11" & m
Else
indicateursParMois.Add 0, "B11" & m
End If

If Not iB(0) = 0 Then
indicateursParMois.Add iB(3) / iB(0), "B14" & m
Else
indicateursParMois.Add 0, "B14" & m
End If

indicateursParMois.Add iC(0) / iA(0), "C2" & m
indicateursParMois.Add iC(1), "C9" & m

For i = 1 To 27
indicateursParMois.Add 100 * rT(i) / rT(0), "rT" & i & m
Next
End If
Next month

Else
Set indicateursParMois = New Collection
'Pour chaque mois sélectionné
For month = LBound(selectedMonth) To UBound(selectedMonth)

ReDim iA(0 To 7)
ReDim iB(0 To 3)
ReDim iC(0 To 1)
ReDim rT(0 To 27)

m = selectedMonth(month)

For Each it In selectedItem

If Not it = "" Then
indicateursParMois.Add 0, "A3" & it & m
indicateursParMois.Add 0, "A4" & it & m
indicateursParMois.Add 0, "A6" & it & m
indicateursParMois.Add 0, "A7" & it & m
indicateursParMois.Add 0, "A8" & it & m
indicateursParMois.Add 0, "A9" & it & m
indicateursParMois.Add 0, "A11" & it & m
indicateursParMois.Add 0, "A14" & it & m
indicateursParMois.Add 0, "B1" & it & m
indicateursParMois.Add 0, "B5" & it & m
indicateursParMois.Add 0, "B7" & it & m
indicateursParMois.Add 0, "B11" & it & m
indicateursParMois.Add 0, "B14" & it & m
indicateursParMois.Add 0, "C2" & it & m
indicateursParMois.Add 0, "C9" & it & m

For j = 0 To 27
indicateursParMois.Add 0, "rt" & j & it & m
Next
End If
Next

For Each it In selectedItem
If Not it = "" Then

m = selectedMonth(month)

cols = getCols(m, it)

For Each i In cols

If Not i = "" Then

'indicateur A
'A3
iA(0) = iA(0) + Sheets(m).Cells(6, i).Value2
tmp = indicateursParMois.item("A3" & it & m)
indicateursParMois.Remove ("A3" & it & m)
indicateursParMois.Add tmp + Sheets(m).Cells(6, i).Value2, "A3" & it & m
'A4
iA(1) = iA(1) + Sheets(m).Cells(6, i).Value2 * Sheets(m).Cells(7, i).Value2
tmp = indicateursParMois.item("A4" & it & m)
indicateursParMois.Remove ("A4" & it & m)
indicateursParMois.Add tmp + Sheets(m).Cells(6, i).Value2 * Sheets(m).Cells(7, i).Value2, "A4" & it & m
'A6
iA(2) = iA(2) + Sheets(m).Cells(6, i).Value2 * Sheets(m).Cells(9, i).Value2
tmp = indicateursParMois.item("A6" & it & m)
indicateursParMois.Remove ("A6" & it & m)
indicateursParMois.Add tmp + Sheets(m).Cells(6, i).Value2 * Sheets(m).Cells(9, i).Value2, "A6" & it & m
'A7
iA(3) = iA(3) + Sheets(m).Cells(6, i).Value2 * Sheets(m).Cells(10, i).Value2
tmp = indicateursParMois.item("A7" & it & m)
indicateursParMois.Remove ("A7" & it & m)
indicateursParMois.Add tmp + Sheets(m).Cells(6, i).Value2 * Sheets(m).Cells(10, i).Value2, "A7" & it & m
'A8
iA(4) = iA(4) + Sheets(m).Cells(6, i).Value2 * Sheets(m).Cells(11, i).Value2
tmp = indicateursParMois.item("A8" & it & m)
indicateursParMois.Remove ("A8" & it & m)
indicateursParMois.Add tmp + Sheets(m).Cells(6, i).Value2 * Sheets(m).Cells(11, i).Value2, "A8" & it & m
'A9
iA(5) = iA(5) + Sheets(m).Cells(12, i).Value2
tmp = indicateursParMois.item("A9" & it & m)
indicateursParMois.Remove ("A9" & it & m)
indicateursParMois.Add tmp + Sheets(m).Cells(12, i).Value2, "A9" & it & m
'A11
iA(6) = iA(6) + Sheets(m).Cells(6, i).Value2 * Sheets(m).Cells(14, i).Value2
tmp = indicateursParMois.item("A11" & it & m)
indicateursParMois.Remove ("A11" & it & m)
indicateursParMois.Add tmp + Sheets(m).Cells(6, i).Value2 * Sheets(m).Cells(14, i).Value2, "A11" & it & m
'A14
iA(7) = iA(7) + Sheets(m).Cells(16, i).Value2
tmp = indicateursParMois.item("A14" & it & m)
indicateursParMois.Remove ("A14" & it & m)
indicateursParMois.Add tmp + Sheets(m).Cells(16, i).Value2, "A14" & it & m

'indicateur B
'B1
iB(0) = iB(0) + Sheets(m).Cells(110, i).Value2
tmp = indicateursParMois.item("B1" & it & m)
indicateursParMois.Remove ("B1" & it & m)
indicateursParMois.Add tmp + Sheets(m).Cells(110, i).Value2, "B1" & it & m
'B5
iB(1) = iB(1) + Sheets(m).Cells(114, i).Value2
tmp = indicateursParMois.item("B5" & it & m)
indicateursParMois.Remove ("B5" & it & m)
indicateursParMois.Add tmp + Sheets(m).Cells(114, i).Value2, "B5" & it & m
'B7
iB(2) = iB(2) + Sheets(m).Cells(115, i).Value2
tmp = indicateursParMois.item("B7" & it & m)
indicateursParMois.Remove ("B7" & it & m)
indicateursParMois.Add tmp + Sheets(m).Cells(115, i).Value2, "B7" & it & m
'B14
iB(3) = iB(3) + Sheets(m).Cells(122, i).Value2
tmp = indicateursParMois.item("B14" & it & m)
indicateursParMois.Remove ("B14" & it & m)
indicateursParMois.Add tmp + Sheets(m).Cells(122, i).Value2, "B14" & it & m

'indicateur C
'C2
iC(0) = iC(0) + Sheets(m).Cells(124, i).Value2
tmp = indicateursParMois.item("C2" & it & m)
indicateursParMois.Remove ("C2" & it & m)
indicateursParMois.Add tmp + Sheets(m).Cells(124, i).Value2, "C2" & it & m
'C9
iC(1) = iC(1) + Sheets(m).Cells(132, i).Value2
tmp = indicateursParMois.item("C9" & it & m)
indicateursParMois.Remove ("C9" & it & m)
indicateursParMois.Add tmp + Sheets(m).Cells(132, i).Value2, "C9" & it & m

'répartition des tâches
rT(0) = rT(0) + Sheets(m).Cells(58, i).Value2
tmp = indicateursParMois.item("rt0" & it & m)
indicateursParMois.Remove ("rt0" & it & m)
indicateursParMois.Add tmp + Sheets(m).Cells(58, i).Value2, "rt0" & it & m

For j = 1 To 27
rT(j) = rT(j) + Sheets(m).Cells(27 + j, i).Value2 * Sheets(m).Cells(58, i).Value2
tmp = indicateursParMois.item("rt" & j & it & m)
indicateursParMois.Remove ("rt" & j & it & m)
indicateursParMois.Add tmp + Sheets(m).Cells(27 + j, i).Value2 * Sheets(m).Cells(58, i).Value2, "rt" & j & it & m
Next
End If
Next
End If
Next

For Each it In selectedItem

If Not it = "" Then
If Not indicateursParMois.item("A3" & it & m) = 0 Then
tmp = indicateursParMois.item("A4" & it & m) / indicateursParMois.item("A3" & it & m)
indicateursParMois.Remove ("A4" & it & m)
indicateursParMois.Add tmp, "A4" & it & m

tmp = indicateursParMois.item("A6" & it & m) / indicateursParMois.item("A3" & it & m)
indicateursParMois.Remove ("A6" & it & m)
indicateursParMois.Add tmp, "A6" & it & m

tmp = indicateursParMois.item("A7" & it & m) / indicateursParMois.item("A3" & it & m)
indicateursParMois.Remove ("A7" & it & m)
indicateursParMois.Add tmp, "A7" & it & m

tmp = indicateursParMois.item("A8" & it & m) / indicateursParMois.item("A3" & it & m)
indicateursParMois.Remove ("A8" & it & m)
indicateursParMois.Add tmp, "A8" & it & m

tmp = indicateursParMois.item("A11" & it & m) / indicateursParMois.item("A3" & it & m)
indicateursParMois.Remove ("A11" & it & m)
indicateursParMois.Add tmp, "A11" & it & m

tmp = 100 * indicateursParMois.item("A14" & it & m) / indicateursParMois.item("A3" & it & m)
indicateursParMois.Remove ("A14" & it & m)
indicateursParMois.Add tmp, "A14" & it & m

If Not indicateursParMois.item("B5" & it & m) = 0 Then
tmp = 100 * indicateursParMois.item("B7" & it & m) / indicateursParMois.item("B5" & it & m)
indicateursParMois.Remove ("B7" & it & m)
indicateursParMois.Add tmp, "B7" & it & m
Else
indicateursParMois.Remove ("B7" & it & m)
indicateursParMois.Add 0, "B7" & it & m
End If

If Not indicateursParMois.item("rt13" & it & m) = 0 Then
tmp = indicateursParMois.item("B1" & it & m) / indicateursParMois.item("rt13" & it & m)
indicateursParMois.Remove ("B11" & it & m)
indicateursParMois.Add tmp, "B11" & it & m
Else
indicateursParMois.Remove ("B11" & it & m)
indicateursParMois.Add 0, "B11" & it & m
End If


If Not indicateursParMois.item("B1" & it & m) = 0 Then
tmp = indicateursParMois.item("B14" & it & m) / indicateursParMois.item("B1" & it & m)
indicateursParMois.Remove ("B14" & it & m)
indicateursParMois.Add tmp, "B14" & it & m

Else
indicateursParMois.Remove ("B14" & it & m)
indicateursParMois.Add 0, "B14" & it & m
End If

tmp = indicateursParMois.item("C2" & it & m) / indicateursParMois.item("A3" & it & m)
indicateursParMois.Remove ("C2" & it & m)
indicateursParMois.Add tmp, "C2" & it & m

For j = 1 To 27
tmp = indicateursParMois.item("rt" & j & it & m) / indicateursParMois.item("rt0" & it & m)
indicateursParMois.Remove ("rt" & j & it & m)
indicateursParMois.Add tmp, "rt" & j & it & m

Next
End If
End If
Next

If Not iA(0) = 0 Then

indicateursParMois.Add iA(0), "A3" & m
indicateursParMois.Add iA(1) / iA(0), "A4" & m
indicateursParMois.Add iA(2) / iA(0), "A6" & m
indicateursParMois.Add iA(3) / iA(0), "A7" & m
indicateursParMois.Add iA(4) / iA(0), "A8" & m
indicateursParMois.Add iA(5), "A9" & m
indicateursParMois.Add iA(6) / iA(0), "A11" & m
indicateursParMois.Add 100 * iA(7) / iA(0), "A14" & m
indicateursParMois.Add iB(0), "B1" & m

If Not iB(1) = 0 Then
indicateursParMois.Add 100 * iB(2) / iB(1), "B7" & m
Else
indicateursParMois.Add 0, "B7" & m
End If

If Not rT(13) = 0 Then
indicateursParMois.Add iB(0) / rT(13), "B11" & m
Else
indicateursParMois.Add 0, "B11" & m
End If

If Not iB(0) = 0 Then
indicateursParMois.Add iB(3) / iB(0), "B14" & m
Else
indicateursParMois.Add 0, "B14" & m
End If

indicateursParMois.Add iC(0) / iA(0), "C2" & m
indicateursParMois.Add iC(1), "C9" & m

For j = 1 To 27
indicateursParMois.Add 100 * rT(j) / rT(0), "rT" & j & m
Next
End If
Next month

End If

For i = LBound(selectedIndic) To UBound(selectedIndic)

Dim valueIndic As Variant
ReDim valueIndic(LBound(selectedMonth) To UBound(selectedMonth))

For month = LBound(valueIndic) To UBound(valueIndic)
'calcul de l'indicateur pour le mois month

If IsInCollection(selectedIndic(0) & selectedMonth(month), indicateursParMois) Then
valueIndic(month) = indicateursParMois.item(selectedIndic(i) & selectedMonth(month))
Else
valueIndic(month) = 0
End If
Next month

Set myChtObj = ActiveSheet.ChartObjects.Add _
(Left:=Range("E15").Left + i * 400, Width:=375, Top:=Range("E15").Top, Height:=225)
With myChtObj.Chart

.HasTitle = True
.ChartTitle.Caption = "Indicateur " + selectedIndic(i)
.ChartType = xlColumnClustered

Set srs = .SeriesCollection.NewSeries
With srs
.XValues = selectedMonth
.Values = valueIndic
.Name = "Globale"
End With

For Each it In selectedItem

If Not it = "" Then

Dim valuePerItem As Variant
ReDim valuePerItem(LBound(selectedMonth) To UBound(selectedMonth))

For j = LBound(selectedMonth) To UBound(selectedMonth)
valuePerItem(j) = indicateursParMois.item(selectedIndic(i) & it & selectedMonth(j))
Next j

Set srs = .SeriesCollection.NewSeries
With srs
.XValues = selectedMonth
.Values = valuePerItem
.Name = it
End With

If selectedIndic(i) = "A14" Or selectedIndic(i) = "B7" Then
.Axes(xlValue).Select
Selection.TickLabels.NumberFormat = "0.00%"
End If

If selectedIndic(i) = "A4" Or selectedIndic(i) = "A6" Or selectedIndic(i) = "A7" Or selectedIndic(i) = "A8" Or selectedIndic(i) = "A11" Then
.Axes(xlValue).Select
Selection.TickLabels.NumberFormat = "hh:mm:ss"
End If
End If
Next

With .Axes(xlCategory)
.HasTitle = True
.AxisTitle.Caption = "Mois"
End With

If selectedIndic(i) = "A14" Or selectedIndic(i) = "B7" Then
.Axes(xlValue).Select
Selection.TickLabels.NumberFormat = "0.00%"
End If

If selectedIndic(i) = "A4" Or selectedIndic(i) = "A6" Or selectedIndic(i) = "A7" Or selectedIndic(i) = "A8" Or selectedIndic(i) = "A11" Then
.Axes(xlValue).Select
Selection.TickLabels.NumberFormat = "hh:mm:ss"
End If
End With
Next

Set myChtObj = ActiveSheet.ChartObjects.Add _
(Left:=Range("E32").Left, Width:=510, Top:=Range("E32").Top, Height:=405)
With myChtObj.Chart

.HasTitle = True
.ChartTitle.Caption = "Répartition des tâches"
.ChartType = xlColumnStacked100

For i = 1 To 27
Dim rtParMois As Variant
ReDim rtParMois(LBound(selectedMonth) To UBound(selectedMonth))

For j = LBound(selectedMonth) To UBound(selectedMonth)
If IsInCollection("rT" & i & selectedMonth(j), indicateursParMois) Then
rtParMois(j) = indicateursParMois.item("rT" & i & selectedMonth(j))
Else
rtParMois(j) = 0
End If
Next j

Set srs = .SeriesCollection.NewSeries
With srs
.XValues = selectedMonth
.Values = rtParMois
.Name = "Répartition des tâches " & i
End With
Next i

With .Axes(xlCategory)
.HasTitle = True
.AxisTitle.Caption = "Mois"
End With

End With
End If

End Sub

Private Function getListDirector() As Variant
Dim directors As Variant
ReDim directors(0 To 0)

Dim i, col, nbCol As Long
Dim m, dir As String

mois = Array("Année", "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Aout", "Septembre", "Octobre", "Novembre", "Décembre")

For i = LBound(mois, 1) + 1 To UBound(mois, 1)
m = mois(i)
nbCol = Sheets(m).Cells(3, Columns.Count).End(xlToLeft).Column

For col = 2 To nbCol
dir = Sheets(m).Cells(3, col).Value2

If Not IsInArray(dir, directors) Then 'Si le Directeur n'a pas déjà été trouvé
'on ajoute le Directeur au tableau
directors(UBound(directors)) = dir
'on augmente la taille du tableau
ReDim Preserve directors(LBound(directors) To UBound(directors) + 1)
End If
Next
Next

'suppression de la dernière case vide
ReDim Preserve directors(LBound(directors) To UBound(directors) - 1)

'todo : trier le tableau
getListDirector = directors
End Function

Private Function getListTeam(director As String) As Variant
Dim teams As Variant
ReDim teams(0 To 0)

mois = Array("Année", "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Aout", "Septembre", "Octobre", "Novembre", "Décembre")

If Not director = "" Then
teams(0) = "Tous"
ReDim Preserve teams(0 To 1)
End If

Dim i, col, nbCol As Long
Dim m, team As String

For i = LBound(mois, 1) + 1 To UBound(mois, 1)
m = mois(i)
nbCol = Sheets(m).Cells(2, Columns.Count).End(xlToLeft).Column

For col = 2 To nbCol
team = Sheets(m).Cells(2, col).Value2
pos = InStr(team, director)

If Not pos = 0 Then

If Not IsInArray(team, teams) Then 'Si le Responsable d'équipe n'a pas déjà était trouvé

'on ajoute le Responsable d'équipe au tableau
teams(UBound(teams)) = team
'on augmente la taille du tableau
ReDim Preserve teams(LBound(teams) To UBound(teams) + 1)
End If
End If
Next
Next
'suppression de la dernière case vide
ReDim Preserve teams(LBound(teams) To UBound(teams) - 1)

getListTeam = teams
End Function

Private Function getListWorker(team As String) As Variant
Dim workers As Variant
ReDim workers(0 To 1)
workers(0) = "Tous"
mois = Array("Année", "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Aout", "Septembre", "Octobre", "Novembre", "Décembre")

Dim i, col, nbCol As Long
Dim m, worker As String

For i = LBound(mois, 1) + 1 To UBound(mois, 1)
m = mois(i)
nbCol = Sheets(m).Cells(1, Columns.Count).End(xlToLeft).Column

For col = 2 To nbCol
worker = Sheets(m).Cells(1, col).Value2

If team = Sheets(m).Cells(2, col).Value2 Then 'Si le travailleur est dans l'équipe

If Not IsInArray(worker, workers) Then 'Si le travailleur n'a pas déjà était trouvé

'on ajoute le travailleur au tableau
workers(UBound(workers)) = worker
'on augmente la taille du tableau
ReDim Preserve workers(LBound(workers) To UBound(workers) + 1)
End If
End If
Next
Next
'suppression de la dernière case vide
ReDim Preserve workers(LBound(workers) To UBound(workers) - 1)

getListWorker = workers
End Function

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

Function IsInCollection(key As String, col As Collection) As Boolean
On Error GoTo handleerror:
Dim val As Variant

val = col.item(key)
IsInCollection = True
Exit Function

handleerror:
IsInCollection = False
End Function


Function getCols(sheet As Variant, item As Variant) As Variant

Dim col, nbCol, row As Long
Dim cols As Variant
Dim w As String

ReDim cols(0 To 1)
col = 1

If ComboBox1.Value = "Directeur" Then
row = 2
Else
row = 1
End If

nbCol = Sheets(sheet).Cells(row, Columns.Count).End(xlToLeft).Column

While col < nbCol

col = col + 1

w = Sheets(sheet).Cells(row, col).Value2

If w = item Then
'on ajoute l'item au tableau
cols(UBound(cols)) = col
'on augmente la taille du tableau
ReDim Preserve cols(LBound(cols) To UBound(cols) + 1)
End If
Wend


'suppression de la dernière case vide
ReDim Preserve cols(LBound(cols) To UBound(cols) - 1)

getCols = cols
End Function
A voir également:

2 réponses

gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 688
7 janv. 2017 à 11:16
Bonjour,

Tu n'as pas mis de balises à ton code énorme et donc c'est totalement illisible : rajoute les balises si tu veux une réponse.
0
Merci pour ta réponse.

Je suis complètement novice sur le sujet, je débute.
Peux-tu m'éclaircir davantage s'il te plait?
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 688
7 janv. 2017 à 18:18
Bonsoir,
Dans la fenêtre de réponse tu as un icône flèche en bas (à droite) et tu choisis "basic" après avoir sélectionné ton code.
0