Macro remplissage graphique avec une image selon valeur [résolu]

[jo91379]

Bonjour,

Suite à d'un certain temps passé sur ce forum j'ai récupéré à droite à gauche des bouts de macros pour créer la macro ci dessous dont l'objectif est de créer un graphe à bulle.
Je cherche dorénavant à remplir chacune de mes bulles avec une image différente en fonction de deux valeurs (je suis obligé de remplir par une image car je souhaite cumuler deux infos dans le remplissage).

Avec l'enregistreur j'obtiens :

With Selection.Format.Fill
.Visible = msoTrue
.UserPicture "D:\Users\martin\Pictures\Rouge S.png"
.TextureTile = msoFalse
End With

Mais je n'arrive pas à l'utliser...

Une idée?

Merci beaucoup

 

[Gareth]

Re : Macro remplissage graphique avec une image selon valeur

Bonsoir,

Ci-joint un bout de code à tester.

 

[jo91379]

Re : Macro remplissage graphique avec une image selon valeur

Merci Gareth!

Cependant, quand je teste ce code, j'obtiens l'erreur suivante : "La méthode 'UserPicture' de l'objet 'FillFormat' a échoué

J'ai juste changé les noms de fichiers et le chemin :

Sub Test()
'Pour tester, copier 4 images img1.jpg etc.. dans le dossier 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("F3").Offset(i - 1, 0).Value
Var2 = Switch(Var1 = 1, "Orange D.jpg", Var1 = 2, "Rouge D.jpg", Var1 = 3, "Vert D.jpg", Var1 = 4, "Vert S.jpg")
.SeriesCollection(1).Points(i).Format.Fill.UserPicture Chemin & Var2
Next
End With
End Sub

J'ai fait une erreur de manip?

Merci

 

[Gareth]

Re : Macro remplissage graphique avec une image selon valeur

Bonsoir,

Est-ce que mon code fontionne tel quel en le testant avec C:\Test et img1.jpg etc ... ?
Je reproduis le message s'il y a une erreur de chemin.
Quelle est ta version d'Excel ?

 

[jo91379]

Re : Macro remplissage graphique avec une image selon valeur

Gareth,

je crois effectivement que j'avais fait une erreur car ça semble fonctionner. Je prend quelques temps pour tout remettre d'aplomb et insérer au code global et je t'envoie le résultat.

Merci beaucoup

 

[jo91379]

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!