Re : Macro remplissage graphique avec une image selon valeur
Bonjour Gareth,
j'ai finalement pu résoudre mes erreurs. Pour info, voila ce que ça donne au final :
Sub cree_graphe()
Sheets("Data").Select
Range("B3").Select
Range(ActiveCell, ActiveCell.End(xlDown).End(xlToRight)).Select
Set maplage = Selection ' Plage du graphique
Charts.Add
ActiveChart.ChartType = xlBubble
ActiveChart.SetSourceData Source:=maplage, PlotBy:=xlColumns
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Portefeuille de projet"
ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowLabel
ActiveChart.PlotArea.Select
With Selection.Interior
.ColorIndex = 2
.Pattern = xlSolid
End With
couleur_texte_fond
End Sub
Sub couleur_texte_fond()
Application.ScreenUpdating = False
ActiveChart.Axes(xlCategory).Select
ActiveChart.Axes(xlCategory).MinimumScale = 0.5
ActiveChart.Axes(xlCategory).MaximumScale = 7
ActiveChart.Axes(xlValue).TickLabels.Font.Size = 6
ActiveChart.Axes(xlValue).MinimumScale = 0.5
ActiveChart.Axes(xlValue).MaximumScale = 5.5
ActiveChart.Axes(xlCategory).TickLabels.Font.Size = 6
ActiveChart.Axes(xlCategory).Select
Selection.Delete
ActiveChart.Axes(xlValue).Select
Selection.Delete
'--titres
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = Sheets("Données projets").Range("M7")
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = Sheets("data").Cells(2, 2)
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Sheets("data").Cells(2, 3)
End With
ActiveChart.Legend.Delete
ActiveChart.Axes(xlValue).HasMajorGridlines = False
ActiveChart.Axes(xlCategory).HasMajorGridlines = True
ActiveChart.SeriesCollection(1).Select
ActiveChart.ChartGroups(1).BubbleScale = 60
Selection.Has3DEffect = False
ActiveChart.SeriesCollection(1).DataLabels.Select
Selection.Font.Size = 7
Nb_points = ActiveChart.SeriesCollection(1).Points.Count
Chemin = "D:\Users\martel\Test\" 'Dossier contenant les images
For i = 1 To Nb_points
ActiveChart.SeriesCollection(1).Points(i).DataLabel.Select
Selection.Text = Sheets("data").Cells(i + 2, 1)
Selection.Interior.ColorIndex = Sheets("data").Cells(i + 2, 1).Interior.ColorIndex
Selection.Font.ColorIndex = Sheets("data").Cells(i + 2, 1).Font.ColorIndex
Selection.Position = xlLabelPositionAbove
Next i
Test
On Error Resume Next
End Sub
Sub Test()
Chemin = "D:\Users\martel\Test\" 'Dossier contenant les images
With Charts("Portefeuille de projet")
For i = 1 To .SeriesCollection(1).Points.Count
Var1 = Sheets("Data").Range("H3").Offset(i - 1, 0).Value
Var2 = Switch(Var1 = "1+", "1+.jpg", Var1 = "1-", "1-.jpg", Var1 = "1=", "1=.jpg", Var1 = "2+", "2+.jpg", Var1 = "2-", "2-.jpg", Var1 = "2=", "2=.jpg", Var1 = "3+", "3+.jpg", Var1 = "3-", "3-.jpg", Var1 = "3=", "3=.jpg")
.SeriesCollection(1).Points(i).Format.Fill.UserPicture Chemin & Var2
Next i
End With
End Sub
Merci beaucoup!