VBA, Attach logos to a Scatter Plot

[jcauteru]

Hi All,

I have an interesting task here, never used VBA for anything like this before so I'm not quite sure how to go about it. I have a scatter plot of say 100 companies and I need to replace each "dot" with that company's logo. I have all the logos collected, and it is simple enough to identify an individual dot:

SeriesCollection(2).Points(XX).Select

but I'm really not sure which direction to take it in. I'm not looking for code necessarily (although it would be nice), just wanted to get some thoughts.

 

[Sal Paradise]

Personally I'd record a macro of copy-pasting the logo on a certain point, and then look at the code and create a loop to do the same for all points.

When I use the macro recorder I get this:

    ActiveSheet.Shapes("Oval 2").Select
    Selection.Copy
    ActiveSheet.ChartObjects("グラフ 1").Activate
    ActiveChart.SeriesCollection(1).Select
    Selection.Paste

(sorry, Japanese Excel -- the squigglies say "Graph 1")

That pastes for a single series though -- if you want to do it for points, you may need to do it slightly differently. I get this:

    ActiveWindow.Visible = False
    Windows("Book1").Activate
    Range("D22").Select
    ActiveSheet.Shapes("Oval 2").Select
    Selection.Copy
    ActiveSheet.ChartObjects("グラフ 3").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).Points(15).Select
    Selection.Paste

After that, it's just a matter of making sure you get all the proper points/logos lined up correctly.

 

[jcauteru]

Thanks a lot, that is a really good idea. I guess I'll just need to make the logo numbers match up with the point numbers then iterate.

Thanks for the Katagana translation. Funny coincidence, I speak Japanese.

Thanks again!

 

[Sal Paradise]

Good luck, let us know if it works.

(Naturally, you can remove the ".Select" and then "Selection.Copy" parts and just change it to ".Copy" on the object and other code improvements, but the concept is the same)

 

[NdNoviceHlp]

Seemed interesting so here's for 1 point. HTH. Dave

Sub Test
'add .gif to chart point/label
With ActiveChart.SeriesCollection(1).Points(1)
.MarkerStyle = xlMarkerStylePicture
End With

Dim FS As Object
Set FS = CreateObject("Scripting.FileSystemObject")
'****adjust file path to suit
If FS.fileexists("C:\picname.gif") Then
With Sheets("Sheet1").ChartObjects(1).Chart
.Pictures.Insert ("C:\picname.gif")
With .Shapes(1)
'adjust .gif size
.LockAspectRatio = msoFalse
.Width = (0.7 * .Width)
.Height = (0.7 * .Height)
.Copy
.Delete
End With
End With
End If
Set FS = Nothing
ActiveChart.SeriesCollection(1).Points(1).Paste
Application.CutCopyMode = False
End Sub