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 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163
| Public Sub GrafAnime()
Dim E As Object
Dim TabGraf As Object
Dim Graf As Object
Dim GrafData As String
'Dim Table As Object
Set TabGraf = CreateObject("Excel.Application")
TabGraf.DisplayAlerts = False
TabGraf.Workbooks.Add
TabGraf.Visible = True
ActiveSheet.PageSetup.Orientation = xlLandscape
Set RecL = DB.OpenRecordset("Select activité, sum(nb_h) As somme From Saisie_suivi_activité " _
& " Where date>=#" & DateBegin & "# And date<=#" & DateEnd & "# and activité not like 'congé*' Group By activité Order By activité")
If RecL.EOF = False Then
For L = 1 To RecL.RecordCount
TabGraf.Cells(L, 1) = Format(RecL.Fields("activité"))
TabGraf.Cells(L, 2) = Format(RecL.Fields("somme"))
RecL.MoveNext
Next L
Set Graf = TabGraf.Charts.Add
'Charts.Add
Graf.ChartType = xl3DPieExploded
GrafData = "A1:B" & RecL.RecordCount
Graf.SetSourceData Source:=Sheets("Feuil1").Range(GrafData), PlotBy _
:=xlColumns
Graf.Location Where:=xlLocationAsObject, Name:="Feuil1"
TabGraf.ActiveSheet.Shapes("Graphique 1").IncrementLeft -231.75
TabGraf.ActiveSheet.Shapes("Graphique 1").IncrementTop -112.5
TabGraf.ActiveSheet.Shapes("Graphique 1").ScaleWidth 1.41, msoFalse, _
msoScaleFromTopLeft
TabGraf.ActiveSheet.Shapes("Graphique 1").ScaleHeight 1.65, msoFalse, _
msoScaleFromTopLeft
TabGraf.ActiveSheet.Shapes("Graphique 1").ScaleWidth 1.17, msoFalse, msoScaleFromTopLeft
TabGraf.ActiveSheet.Shapes("Graphique 1").ScaleHeight 1.17, msoFalse, msoScaleFromTopLeft
ActiveChart.Legend.Select
Selection.AutoScaleFont = True
With Selection.Font
.Size = 9
End With
ActiveChart.ChartArea.Select
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.Position = xlBottom
ActiveChart.ApplyDataLabels AutoText:=True, LegendKey:=False, _
HasLeaderLines:=True, ShowSeriesName:=False, ShowCategoryName:=False, _
ShowValue:=False, ShowPercentage:=True, ShowBubbleSize:=False
ActiveChart.PlotArea.Select
Selection.Top = 78
Selection.Width = 499
Selection.Height = 197
Selection.Left = 37
Selection.Top = 51
Selection.Width = 561
Selection.Height = 224
Selection.Left = 36
Selection.Top = 60
Selection.Top = 65
ActiveChart.PlotArea.Select
Selection.Top = 85
Selection.Width = 655
Selection.Height = 261
Selection.Width = 666
Selection.Height = 263
ActiveChart.SeriesCollection(1).DataLabels.Select
Selection.AutoScaleFont = True
With Selection.Font
.Size = 15
End With
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
'Selection.Cut
With W.Selection
.Font.Size = 18
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.TypeText "Répartition du temps de travail au vu des différentes activités du " & Format(DateBegin) & " au " & Format(DateEnd)
.TypeParagraph
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.TypeParagraph
.Paste
End With
TabGraf.Quit
Set TabGraf = Nothing
End If
Set TabGraf = CreateObject("Excel.Application")
TabGraf.DisplayAlerts = False
TabGraf.Workbooks.Add
TabGraf.Visible = True
Set RecL = DB.OpenRecordset("Select motif, count([date du contact]) As compte From [suivi contact_zone] " _
& " Where [qui ?]='ASMAT' And [date du contact]>= #" & DateBegin & "# and [date du contact]<= #" & DateEnd & "# Group By motif")
If RecL.EOF = False Then
For L = 1 To RecL.RecordCount
TabGraf.Cells(L, 1) = Format(RecL.Fields("motif"))
TabGraf.Cells(L, 2) = Format(RecL.Fields("compte"))
RecL.MoveNext
Next L
TabGraf.Sheets("Feuil1").Select
'tableau.Range(tableau.Cells(1, 1), tableau.Cells(RecL.RecordCount, 2)).Select
Set Graf = TabGraf.Charts.Add
'Charts.Add
Graf.ChartType = xl3DPieExploded
GrafData = "A1:B" & RecL.RecordCount
Graf.SetSourceData Source:=Sheets("Feuil1").Range(GrafData), PlotBy _
:=xlColumns
Graf.Location Where:=xlLocationAsObject, Name:="Feuil1"
TabGraf.ActiveSheet.Shapes("Graphique 1").IncrementLeft -231.75
TabGraf.ActiveSheet.Shapes("Graphique 1").IncrementTop -112.5
TabGraf.ActiveSheet.Shapes("Graphique 1").ScaleWidth 1.41, msoFalse, _
msoScaleFromTopLeft
TabGraf.ActiveSheet.Shapes("Graphique 1").ScaleHeight 1.65, msoFalse, _
msoScaleFromTopLeft
TabGraf.ActiveSheet.Shapes("Graphique 1").ScaleWidth 1.17, msoFalse, msoScaleFromTopLeft
TabGraf.ActiveSheet.Shapes("Graphique 1").ScaleHeight 1.17, msoFalse, msoScaleFromTopLeft
ActiveChart.Legend.Select
Selection.AutoScaleFont = True
With Selection.Font
.Size = 9
End With
ActiveChart.ChartArea.Select
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.Position = xlBottom
ActiveChart.ApplyDataLabels AutoText:=True, LegendKey:=False, _
HasLeaderLines:=True, ShowSeriesName:=False, ShowCategoryName:=False, _
ShowValue:=False, ShowPercentage:=True, ShowBubbleSize:=False
ActiveChart.PlotArea.Select
Selection.Top = 78
Selection.Width = 499
Selection.Height = 197
Selection.Left = 37
Selection.Top = 51
Selection.Width = 561
Selection.Height = 224
Selection.Left = 36
Selection.Top = 60
Selection.Top = 65
ActiveChart.PlotArea.Select
Selection.Top = 85
Selection.Width = 655
Selection.Height = 261
Selection.Width = 666
Selection.Height = 263
ActiveChart.SeriesCollection(1).DataLabels.Select
Selection.AutoScaleFont = True
With Selection.Font
.Size = 15
End With
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
'Selection.Cut
With W.Selection
.Font.Size = 18
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.TypeText "Répartition du temps de travail au vu des différentes activités du " & Format(DateBegin) & " au " & Format(DateEnd)
.TypeParagraph
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.TypeParagraph
.Paste
End With
TabGraf.Quit
Set TabGraf = Nothing
End If
End Sub |
Partager