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
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
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:
- VBA/ code qui ne fonctionne pas
- Code ascii - Guide
- Code puk bloqué - Guide
- Code activation windows 10 - Guide
- Code deverouillage telephone perdu - Guide
- Code blocks - Télécharger - Langages
2 réponses
gbinforme
Messages postés
14946
Date d'inscription
lundi 18 octobre 2004
Statut
Contributeur
Dernière intervention
24 juin 2020
4 718
7 janv. 2017 à 11:16
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.
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.
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?
Je suis complètement novice sur le sujet, je débute.
Peux-tu m'éclaircir davantage s'il te plait?
gbinforme
Messages postés
14946
Date d'inscription
lundi 18 octobre 2004
Statut
Contributeur
Dernière intervention
24 juin 2020
4 718
7 janv. 2017 à 18:18
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.
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.