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
|
Sub MinigraphD(pl)
Dim LinMiniTab As Double
Dim TpsPrev As Double
Dim TpsReel As Double
LinMiniTab = 12 * pl + 4
'Création du minigraph
Charts.Add
ActiveChart.Location _
Where:=xlLocationAsObject, Name:="Bilan"
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Sheets("Bilan").Range("B18:B19"), PlotBy _
:=xlRows
ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).XValues = "=Bilan!R18C3:R18C4"
ActiveChart.SeriesCollection(1).Values = "=Bilan!R19C3:R19C4"
ActiveChart.SeriesCollection(1).Name = "=Bilan!R19C2"
ActiveChart.Location Where:=xlLocationAsObject, Name:="Bilan"
With ActiveChart
.SetSourceData Range("B" & pl * 12 + 6 & ":D" & pl * 12 + 6 & ",B" & pl * 12 + 8 & ":D" & pl * 12 + 8)
.HasTitle = False
.ChartType = xlColumnClustered
.HasLegend = True
.Axes(xlCategory).TickLabels.Orientation = xlHorizontal
.PlotArea.Top = 0
.PlotArea.Top = 100
.PlotArea.Height = 300
.Axes(xlValue).MaximumScaleIsAuto = True
.HasDataTable = Worksheets("Bilan").TableBox.Value
End With
'Placement/Dimensionnement du minigraph
ActiveSheet.ChartObjects(ActiveChart.Parent.Name).Name = "GraphD" & pl
With ActiveSheet.ChartObjects("GraphD" & pl)
.Left = Range("G" & pl).Left
.Top = Range("B" & (12 * pl + 4)).Top
.Width = Range("G" & (12 * pl + 4) & ":I" & (12 * pl + 13)).Width
.Height = Range("B" & (12 * pl + 4) & ":D" & (12 * pl + 13)).Height
End With
'Formatage du minigraph
ActiveChart.PlotArea.Select
Selection.Top = 1
Selection.Left = 1
Selection.Height = 194
Selection.Width = 350
With ActiveChart
.Axes(xlValue).Select
.Axes(xlValue).TickLabels.AutoScaleFont = True
.Axes(xlValue).MinimumScale = 0
.Legend.Select
End With
ActiveChart.Axes(xlValue).TickLabels.AutoScaleFont = True
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
Selection.Left = 140
Selection.Top = 1
'Coloration conditionnelle
If Worksheets("Bilan").Colorbox.Value = True Then
TpsPrev = IIf(IsError(ThisWorkbook.Worksheets("Bilan").Cells(pl * 12 + 8, 3).Value), 0, ThisWorkbook.Worksheets("Bilan").Cells(pl * 12 + 8, 3).Value)
TpsReel = IIf(IsError(ThisWorkbook.Worksheets("Bilan").Cells(pl * 12 + 8, 4).Value), 0, ThisWorkbook.Worksheets("Bilan").Cells(pl * 12 + 8, 4).Value)
ActiveChart.SeriesCollection(1).Select
'Calcul pour colaration
Select Case TpsReel
Case Is > TpsPrev
ActiveChart.SeriesCollection(1).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
Case Is > TpsPrev - TpsPrev * 20 / 100
ActiveChart.SeriesCollection(1).Select
With Selection.Interior
.ColorIndex = 46
.Pattern = xlSolid
End With
Case Is < TpsPrev
ActiveChart.SeriesCollection(1).Select
With Selection.Interior
.ColorIndex = 50
.Pattern = xlSolid
End With
End Select
Else
ActiveChart.SeriesCollection(1).Select
With Selection.Interior
.ColorIndex = 44
.Pattern = xlSolid
End With
End If
Range("K10").Select
End Sub |
Partager