VBA将图像分配给Excel中的散点图

我有一个Excel的散点图。 情节中的每一点都是指公司。 我希望情节中的每一点都要填入与他们所指的公司相对应的图像。 这些公司的名字从第3行开始在G列。

我已经设法编写一些VBA,将图像加载到与公司名称相关的Excel中。 例如,如果单元格上写有“Microsoft”,则脚本将查找具有相同名称的图片并将其发布到电子表格中的预定义单元格。 现在我想让脚本填充散点图中的“Microsoft”点,并加载它的图像。

该脚本将运行与单元格一样长

Sub Macro2() Dim picname As String Dim shp As Shape Dim pasteAt As Integer Dim lThisRow As Long Dim present As String lThisRow = 3 'This is the start row Do While (Cells(lThisRow, 7) <> "") pasteAt = lThisRow Cells(pasteAt, 2).Select 'This is where picture will be inserted (column) picname = Cells(lThisRow, 7) 'This is the picture name present = Dir("C:\Users\User\Images\" & picname & ".jpg") If present <> "" Then Cells(pasteAt, 2).Select Call ActiveSheet.Shapes.AddPicture("C:\Users\User\Images\" & picname & ".jpg", _ msoCTrue, msoCTrue, Left:=Cells(pasteAt, 2).Left, Top:=Cells(pasteAt, 2).Top, Width:=100, Height:=100).Select End If lThisRow = lThisRow + 1 Loop End Sub 

我现在想补充脚本,以便将图像插入到图表中。

您需要遍历图表中的系列和点。 你并没有指出数据是如何排列和绘制的,但是我会假定图表有一系列的X和Y,公司的列与X和Y的值是平行的。

我试图合并我的补充顺利:

 Sub ImportPicturesAndPutIntoChart() Dim picname As String Dim shp As Shape Dim lThisRow As Long Dim present As String Dim cht As Chart, srs As Series lThisRow = 3 'This is the start row Set cht = ActiveSheet.ChartObjects(1).Chart Set srs = cht.SeriesCollection(1) Do While (Cells(lThisRow, 7) <> "") If lThisRow - 2 > srs.Points.Count Then Exit Do Cells(lThisRow, 2).Select 'This is where picture will be inserted (column) picname = Cells(lThisRow, 7) 'This is the picture name present = Dir("C:\Users\User\Images\" & picname & ".jpg") If present <> "" Then Cells(pasteAt, 2).Select Set shp = Shapes.AddPicture("C:\Users\User\Images\" & picname & ".jpg", _ msoCTrue, msoCTrue, Left:=Cells(lThisRow, 2).Left, Top:=Cells(lThisRow, 2).Top, _ Width:=100, Height:=100) shp.Copy srs.Points(lThisRow - 2).Paste End If lThisRow = lThisRow + 1 Loop End Sub 
Interesting Posts