Option Explicit
Sub Creationgraphique()
Dim wss As Worksheet, wsd As Worksheet
Dim rng As Range
Dim pc As PivotCache
Dim pt As PivotTable
Dim i As Integer
Application.ScreenUpdating = False
Set wss = Worksheets("Graph")
Set wsd = Worksheets("Graph")
Dim strWb As String
Dim Ws As Worksheet
Dim myChtObj As ChartObject
Application.ScreenUpdating = False
Application.DisplayAlerts = False
strWb = ActiveWorkbook.Name
Set Ws = Worksheets("Graph")
On Error Resume Next
Ws.ChartObjects("Graph1").Delete
On Error GoTo 0
Application.DisplayAlerts = True
' on crée le graphique
Set myChtObj = Ws.ChartObjects.Add _
(Left:=20, Width:=600, Top:=100, Height:=400)
myChtObj.Name = "Graph1"
' on définit le graphique
With myChtObj.Chart
.ChartArea.AutoScaleFont = False
.ChartArea.Font.FontStyle = "Trebuchet MS"
' type de graphique
.ChartType = xlXYScatter
.ChartType = xlBubble
' style graphique
.ChartStyle = 24
' on efface les séries existantes
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop
For i = 1 To 13
With .SeriesCollection.NewSeries
.Name = Range("A2:A14")(i)
.XValues = Range("C2:C14")(i)
.Values = Range("D2:D14")(i)
.BubbleSizes = Range("E2:E14")(i)
End With
Next i
'Filtre par Group
Range("B1:B22").AutoFilter
End With
Set Ws = Nothing: Set myChtObj = Nothing
'Ajout des étiquettes
Dim v As Byte
ActiveSheet.ChartObjects(1).Activate
For i = 1 To 13
With ActiveChart.SeriesCollection(i)
.ApplyDataLabels
.DataLabels.Select
Selection.ShowSeriesName = True
Selection.ShowCategoryName = False
Selection.ShowValue = False
.DataLabels.Font.Size = 10
.DataLabels.Border.LineStyle = xlNone
End With
Next i
'Mise en forme du Graphique
ActiveSheet.ChartObjects("Graph1").Activate
ActiveChart.Legend.Select
Selection.Delete 'suppression de la légende
ActiveSheet.ChartObjects("Graph1").Activate
'Gestion des axes
ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
ActiveChart.Axes(xlCategory).AxisTitle.Select 'Axes des abscisses
ActiveChart.Axes(xlCategory, xlPrimary).AxisTitle.Text = "X "
ActiveChart.Axes(xlCategory, xlPrimary).AxisTitle.Font.Size = 20
'Gestion de l'échelle de l'axe des abscisses
ActiveChart.Axes(xlCategory).MinimumScale = 4 'Minimum de l'axe
ActiveChart.Axes(xlCategory).MaximumScale = 20 'Maximum de l'axe
ActiveChart.Axes(xlCategory).MajorUnit = 0.5 'Pas
Selection.Format.TextFrame2.TextRange.Characters.Text = "BUSE" 'Titre de l'axe
ActiveChart.SetElement (msoElementPrimaryValueAxisTitleHorizontal)
ActiveChart.Axes(xlValue).AxisTitle.Select 'Axe des ordonnées
ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Text = "Y "
ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Font.Size = 20
'Gestion de l'échelle de l'axe des ordonnées
ActiveChart.Axes(xlValue).MinimumScale = 5 'Minimun de l'axe
ActiveChart.Axes(xlValue).MaximumScale = 20 'Maximum de l'axe
ActiveChart.Axes(xlValue).MajorUnit = 0.5 'Pas
Selection.Format.TextFrame2.TextRange.Characters.Text = "ASPIC " 'Titre de l'axe
Selection.Left = 7
Selection.Top = 166.758
ActiveChart.Axes(xlValue).MajorGridlines.Select 'suppresion de la grille
Selection.Delete
'Style des traits
ActiveChart.Axes(xlValue).Select
With Selection.Format.Line
.Visible = msoTrue
.Weight = 2.5
End With
ActiveChart.Axes(xlCategory).Select
With Selection.Format.Line
.Visible = msoTrue
.Weight = 2.5
End With
'couleurs des bulles et des étiquettes
ActiveSheet.ChartObjects("Graph1").Activate
For i = 1 To 13
With ActiveChart.SeriesCollection(i)
.Interior.Color = Range("A2:A14")(i).Interior.Color
.DataLabels.Font.Color = Range("A2:A14")(i).Interior.Color
.DataLabels.Font.Bold = msoTrue
.DataLabels.Font.Size = 12
.Format.Fill.Transparency = 0.5
.Format.Line.Visible = msoTrue
.Format.Line.Weight = 1.5
End With
Next i
' Les axes se coupe à 10
ActiveChart.ChartArea.Select
ActiveChart.Axes(xlValue).Select
ActiveChart.Axes(xlValue).CrossesAt = 10
ActiveChart.Axes(xlCategory).Select
ActiveChart.Axes(xlCategory).CrossesAt = 10
'couleur de fond du graphique
ActiveChart.PlotArea.Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 0
.Solid
End With
ActiveSheet.ChartObjects("Graph1").Activate
ActiveSheet.Shapes("Graph1").Fill.Visible = msoFalse
'Taille du graph
ActiveChart.PlotArea.Select
Selection.Top = 10.077
Selection.Height = 363.717
' positionner le Graphique sur la feuille
With ActiveSheet.ChartObjects(1)
.Left = Range("B16:N45").Left
.Top = Range("B16:N45").Top
.Width = Range("B16:N45").Width
.Height = Range("B16:N45").Height
End With
wsd.Activate
Range("A1").Select
Set wss = Nothing: Set wsd = Nothing: Set rng = Nothing
MsgBox "The Graph has been synchronise with the data", vbInformation, "Operation made successfully"
End Sub
