1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
| ' Charge le graph
Private Sub LoadHisto()
Dim MyChart As Chart
Dim ChartData As Range
Dim chartIndex As Integer
'Dim ChartName As String
chartIndex = 0
Application.ScreenUpdating = False
Set MyChart = Worksheets("Feuil2").Shapes.AddChart(xlBarStacked).Chart
With MyChart
.HasTitle = True
.Parent.Name = "Planning"
.ChartTitle.Text = "Planning Cab"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Cab"
.Axes(xlCategory).CategoryNames = Worksheets("Feuil2").Range("A1:F1")
.HasLegend = False
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Heures"
' Met la valeur de 0 de base et 160 heures max mois, ainsi qu un decoupage par 24h
.Axes(xlValue).MinimumScale = 0
.Axes(xlValue).MaximumScale = 250
.Axes(xlValue).MajorUnit = 24
' PART CALCUL ROW FOR EACH COLUMN
Dim lngLastRowA As Long
Dim lngLastRowB As Long
Dim lngLastRowC As Long
Dim lngLastRowD As Long
Dim lngLastRowE As Long
Dim lngLastRowF As Long
lngLastRowA = Worksheets("Feuil2").Cells(Rows.Count, "A").End(xlUp).Row
lngLastRowB = Worksheets("Feuil2").Cells(Rows.Count, "B").End(xlUp).Row
lngLastRowC = Worksheets("Feuil2").Cells(Rows.Count, "C").End(xlUp).Row
lngLastRowD = Worksheets("Feuil2").Cells(Rows.Count, "D").End(xlUp).Row
lngLastRowE = Worksheets("Feuil2").Cells(Rows.Count, "E").End(xlUp).Row
lngLastRowF = Worksheets("Feuil2").Cells(Rows.Count, "F").End(xlUp).Row
Dim incr As Integer
incr = 1
incr = AddSeriesToChart(MyChart, 2, lngLastRowB, "B", incr)
incr = AddSeriesToChart(MyChart, 2, lngLastRowC, "C", incr)
End With
' MsgBox "The default file path is " & Application.DefaultFilePath
Dim imageName As String
imageName = Application.DefaultFilePath & Application.PathSeparator & "TempChart.gif"
MyChart.Export Filename:=imageName
Worksheets("Feuil2").ChartObjects(1).Delete
Application.ScreenUpdating = True
UserForm1.Image1.Picture = LoadPicture(imageName)
LoadPicture (imageName)
End Sub
' Ajoute une series collection au chart
Private Function AddSeriesToChart(MyChart As Chart, ColDebut As Integer, ColFin As Long, RangeName As String, j As Integer) As Integer
Dim i As Integer
Dim ser As Series
With MyChart
i = j
For Each cell In Worksheets("Feuil2").Range(RangeName & ColDebut & ":" & RangeName & "" & ColFin)
'MsgBox (cell.value)
If Not IsEmpty(cell.value) And IsNumeric(cell.value) Then
.SeriesCollection.NewSeries
.SeriesCollection(i).XValues = Worksheets("Feuil2").Range(RangeName & "1:" & RangeName & "1")
.SeriesCollection(i).Values = CalculTimeOF(cell.value)
.SeriesCollection(i).Name = cell.value
'MsgBox (.SeriesCollection(inc).Formula)
.SeriesCollection(i).HasDataLabels = True
.SeriesCollection(i).Points(1).DataLabel.Text = cell.value
.SeriesCollection(i).Points(1).DataLabel.Font.Bold = True
.SeriesCollection(i).Points(1).DataLabel.Font.Color = "White"
i = i + 1
End If
Next cell
End With
AddSeriesToChart = i
End Function
' Renvoi le temps calculer pour chaque OF
Private Function CalculTimeOF(numberOF As String) As Integer
Dim StartDate As Date
Dim EndDate As Date
Dim numberRow As String
Dim DayStart As Integer
Dim DayEnd As Integer
Dim DiffDay As Integer
Dim TimeBase As Integer
Dim TimeDiffDay As Integer
numberRow = FindValueOF(numberOF)
StartDate = Format(CDate(Worksheets("Feuil1").Range("Q" & numberRow).value), "dd/mm/yyyy")
EndDate = Format(CDate(Worksheets("Feuil1").Range("F" & numberRow).value), "dd/mm/yyyy")
DayStart = Day(StartDate)
DayEnd = Day(EndDate)
DiffDay = DayEnd - DayStart
TimeBase = 8
TimeDiffDay = DiffDay * TimeBase
CalculTimeOF = TimeDiffDay
End Function
' Trouve le numero de ligne de l OF selectionné
Private Function FindValueOF(value As String) As String
Dim lngLastRow As Long
Dim strRowNoList As String
intMyVal = 1 'Value to search for, change as required.
lngLastRow = Worksheets("Feuil1").Cells(Rows.Count, "C").End(xlUp).Row 'Search Column A, change as required.
For Each cell In Worksheets("Feuil1").Range("C2:C" & lngLastRow) 'Starting cell is A2, change as required.
If cell.value = value Then
If strRowNoList = "" Then
strRowNoList = strRowNoList & cell.Row
Else
strRowNoList = strRowNoList & ", " & cell.Row
End If
End If
Next cell
FindValueOF = strRowNoList
End Function |
