Sub CreateTimeChartData()
Dim vTimeData As Variant
Dim i As Integer
Dim sRoom As String
Dim vLastEndTime As Variant
Dim oSeries As Series
'\ set up
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'\ create chart data worksheet
With Worksheets("TimeData").Range("TimeList").CurrentRegion
.Sort Key1:="Room", Key2:="Start Time", Header:=xlYes
vTimeData = .Value
Worksheets.Add
On Error Resume Next
Worksheets("ChartData").Delete
Charts("TimeChart").Delete
On Error GoTo 0
ActiveSheet.Name = "ChartData"
.Columns(1).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("A1"), Unique:=True
End With
Range("a1").Select
For i = 2 To UBound(vTimeData)
If vTimeData(i, 1) <> Selection.EntireRow.Cells(1) Then
Selection.Offset(1).EntireRow.Cells(1).Select
Selection.Value = vTimeData(i, 1)
vLastEndTime = 0
End If
Selection.Offset(0, 1).Select
Selection.Value = vTimeData(i, 2) - vLastEndTime
Selection.Offset(0, 1).Select
Selection.Value = vTimeData(i, 3) - vTimeData(i, 2)
vLastEndTime = vTimeData(i, 3)
Next i
With Selection.CurrentRegion
.Offset(0, 1).NumberFormat = "h:mm"
.Columns(2).Cells(1) = "Start Time"
For i = 3 To .Columns.Count
If i Mod 2 <> 0 Then
.Columns(i).Cells(1) = "Used"
Else
.Columns(i).Cells(1) = "Not Used"
End If
Next i
End With
'*******************************************
Range("A1").CurrentRegion.Select
Selection.Copy
Range("A12").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
Rows("1:11").Delete
'*******************************************
'création des graphiques à revoir pour la partie source de données..
Charts.Add
ActiveChart.Name = "TimeChart"
ActiveChart.ChartWizard Source:=Sheets("ChartData").Range("A1").CurrentRegion, _
Gallery:=xlBar, Format:=3, PlotBy:=xlColumns, CategoryLabels _
:=1, SeriesLabels:=1, HasLegend:=2
For Each oSeries In ActiveChart.SeriesCollection
If oSeries.PlotOrder Mod 2 <> 0 Then
oSeries.Border.LineStyle = xlNone
oSeries.Interior.ColorIndex = xlNone
Else
oSeries.Fill.Visible = True
oSeries.Fill.ForeColor.SchemeColor = 5
oSeries.Fill.BackColor.SchemeColor = 5
' oSeries.Interior.ColorIndex = 5
oSeries.Border.LineStyle = xlNone
End If
Next oSeries
With ActiveChart.Axes(xlValue)
.MajorUnit = 0.0416666666
.TickLabels.NumberFormat = "h"
.HasMajorGridlines = True
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Activité timers"
End With
ActiveChart.PlotArea.Select
With Selection.Border
.Weight = xlHairline
.LineStyle = xlAutomatic
End With
Selection.Interior.ColorIndex = xlNone
ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
.MinimumScale = 0
.MaximumScaleIsAuto = True
.MinorUnitIsAuto = True
.MajorUnit = 0.0416666666
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
End Sub
